Home Excel VBA - use the if and countif to clear(not delete) the duplicate cell expect the first item
Reply: 0

Excel VBA - use the if and countif to clear(not delete) the duplicate cell expect the first item

user3098
1#
user3098 Published in July 18, 2018, 10:21 pm

I have two workbooks. one is report.xls, another one is AT.xlsm.

In report.xls, there has the sheet called "Service".

In AT.xlsm, there has the sheet called "Worksheet".

Thanks for the help of @mooseman, it can use the VBA to copy the column B,C,F,J,E,D expect first row of report to the column A,C,D,E,F,H of AT.

After copy the data from the report to AT, i want to remove the duplicate cell(just clear the content of the cell) expect the first item that use the VBA. I know that use the if and countif can work out.

Would you please tell me how to use the if and countif in the VBA to remove the duplicate cell(just clear the content of the cell) expect the first item ?

Thank you very much.

 Sub add_click()

Dim sDirectory As String
Dim sFilename As String
Dim sheet As Worksheet
Dim total As Integer
Dim lastRow As Long
Dim sImportFile As String
Dim totalactive As Integer
Dim readsheetName As String
Dim destsheetName As String

readsheetName = "Service"
destsheetName = "Worksheet"

addWSn = 0
Application.ScreenUpdating = False
Application.DisplayAlerts = False
sDirectory = ActiveWorkbook.Path
sFilename = sDirectory + "\*.xl??"

sImportFile = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", Title:="Open report")
If sImportFile = "False" Then
    MsgBox ("No File")
    Exit Sub
End If

'set destination workbook and worksheet
Set wb2 = ThisWorkbook
Set wsw = wb2.Sheets(destsheetName)
lastRow = wsw.Cells(wsw.Rows.Count, "D").End(xlUp).Row
lastRow = lastRow + 2
Set wb = Workbooks.Open(sImportFile)
Set wss = wb.Sheets(readsheetName)

wss.Range(wss.Cells(2, 2), wss.Cells(wss.Range("B" & wss.Rows.Count).End(xlUp).Row, 2)).Copy
wsw.Cells(lastRow, 1).PasteSpecial Paste:=xlPasteValues

wss.Range(wss.Cells(2, 3), wss.Cells(wss.Range("C" & wss.Rows.Count).End(xlUp).Row, 3)).Copy
wsw.Cells(lastRow, 3).PasteSpecial Paste:=xlPasteValues

wss.Range(wss.Cells(2, 6), wss.Cells(wss.Range("F" & wss.Rows.Count).End(xlUp).Row, 6)).Copy
wsw.Cells(lastRow, 4).PasteSpecial Paste:=xlPasteValues

wss.Range(wss.Cells(2, 10), wss.Cells(wss.Range("J" & wss.Rows.Count).End(xlUp).Row, 10)).Copy
wsw.Cells(lastRow, 5).PasteSpecial Paste:=xlPasteValues

wss.Range(wss.Cells(2, 5), wss.Cells(wss.Range("E" & wss.Rows.Count).End(xlUp).Row, 5)).Copy
wsw.Cells(lastRow, 6).PasteSpecial Paste:=xlPasteValues

wss.Range(wss.Cells(2, 4), wss.Cells(wss.Range("D" & wss.Rows.Count).End(xlUp).Row, 4)).Copy
wsw.Cells(lastRow, 8).PasteSpecial Paste:=xlPasteValues

wsw.Range(wsw.Cells(lastRow, 6), wsw.Cells(wsw.Range("F" & wsw.Rows.Count).End(xlUp).Row, 6)).Replace What:="[S]", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
wsw.Columns("E:K").HorizontalAlignment = xlRight

'close excel file
Workbooks.Open (sImportFile)
ActiveWorkbook.Close SaveChanges:=False
End Sub

Updated: @ Maldred The result is partly worked, it can some clear the content of some duplicate.

You need to login account before you can post.

About| Privacy statement| Terms of Service| Advertising| Contact us| Help| Sitemap|
Processed in 0.403425 second(s) , Gzip On .

© 2016 Powered by mzan.com design MATCHINFO