CODEWITHSUNDEEP
excelvba
matr3p
matr3p

Reputation: 73

Deleting duplicate values

I'm trying to delete all duplicate rows based on Column B and leave only the unique rows.

It will leave one of the duplicate entries. I tried with > 1 and = 2.

Sub test1()

    Dim fName As String, fPath As String, wb As Workbook, sh As Worksheet, i As Long, lCopyLastRow As Long, lDestLastRow As Long
    Set sh = ActiveSheet
    fPath = ThisWorkbook.Path & "\"
    fName = Dir(fPath & "*.xls*")
    
    Do
        If fName <> ThisWorkbook.Name Then
        
            Set wb = Workbooks.Open(fPath & fName)
            lCopyLastRow = wb.Sheets(1).Cells(wb.Sheets(1).Rows.Count, "A").End(xlUp).Row
            lDestLastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Offset(1).Row
            wb.Sheets(1).Range("A2:AA1000" & lCopyLastRow).Copy sh.Range("B" & lDestLastRow)
            sh.Range("A1") = "Source"
            
            With sh
                .Range(.Cells(Rows.Count, 1).End(xlUp)(2), .Cells(Rows.Count, 2).End(xlUp).Offset(, -1)) = fName
            End With
            wb.Close
            
        End If
        
        Set wb = Nothing
        fName = Dir
        
    Loop Until fName = ""
    
    For i = sh.UsedRange.Rows.Count To 2 Step -1
        If Application.CountIf(sh.Range("B:B"), sh.Cells(i, 2).Value) > 1 Then Rows(i).Delete
    Next
End Sub

Upvotes: 0

Views: 110

Answers (1)

Ike
Ike

Reputation: 13064

The problem with your code is, that you countIf on the remaining rows - if you already deleted the "other" duplicates the first one is a unique value in the then remaining list.

So you have to count the occurences before deleting.

Sub removeNonUniqueRows()

Dim arrCountOccurences As Variant
ReDim arrCountOccurences(2 To sh.UsedRange.Rows.Count)

Dim i As Long
For i = 2 To sh.UsedRange.Rows.Count
    arrCountOccurences(i) = Application.CountIf(sh.Range("B:B"), sh.Cells(i, 2).Value)
Next

For i = sh.UsedRange.Rows.Count To 2 Step -1
    If arrCountOccurences(i) > 1 Then sh.Rows(i).Delete
Next
End Sub

Upvotes: 1

Related Questions