Compare rows in a column and if match found then compare its column contents using vba

Question

I have a sheet with strings in column B for around 500 rows and I have cells empty/populated with values in column A and Column C to M.

I need a macro which compares every cells in column B with other cells in same column B and finds duplicates and compares the column C to M values of the two duplicate strings and if they are same then delete one of the entire row. Even if one column from c to M values are different between the two duplicate strings then it should do nothing, leave them.

Here is an example of a sheet.

 A      B           C      D        E    F   G   H   I    J    K      L   M
1.2   SERVER_P                     RE1                               GR5 
7.3   PROXY NET         Uchk=Udis                    GR       YT_5
4.5   PROXY NET         Uchk=Udis                    GR       YT_5 
3.5   HT_TIMER     GS1
6.7   NET CON V1   G_5             MH1           TY1      M_5
7.8   NET CON V1   G_5             MH1           RE3      M_5

In the above example it should compare B column cells, so it finds "PROXY NET" and "NET CON V1"as duplicates. Then it should compare columns C to M OF both "PROXY NET" and if the column values are same, it should delete entire row of any one "PROXY NET". But for "NET CON V1" it should not delete, since column H values are different even though other column values are same.

Here is what I have till now

Dim LRow As Long, Count As Long, rcount As Long
Dim matchFoundIndex As Long
Dim matchColIndex As Variant
Dim iCntr As Long 

With Sheets("Inputs")

'count the rows till which strings are there
LRow = .Cells(.Rows.Count, "B").End(xlUp).Row

 For iCntr = LRow To 1 Step -1
    Count = 0
    If Cells(iCntr, 2) <> "" Then
        matchFoundIndex = Application.Match(Cells(iCntr, 2), Range("B1:B" & LRow), 0)
        If iCntr <> matchFoundIndex Then
            Cells(iCntr, 2).Interior.ColorIndex = 3
            Cells(matchFoundIndex, 2).Interior.ColorIndex = 3
            For rcount = 3 To 13
                matchColIndex = Application.Match(Cells(iCntr, rcount), Cells(matchFoundIndex, rcount), 0)
                If Not IsError(matchColIndex) Then
                    Count = Count + 1
                    If Count = 11 Then
                        Rows(matchFoundIndex).EntireRow.Delete
                    End If
                Else
                    rcount = 11
                End If
            Next rcount
        End If
    End If
 Next
End With

The problem the outputs are updated in the sheet "Inputs" but the excel sheet and vba editor window goes to not responding and I am not sure if the output is generated correctly.

Could someone help me with this.

Not sure if it'll fix it, but assuming you want matchFoundIndex to get data from the Inputs sheet, qualify the ranges by adding a . before Cells() and Range(). Same everywhere else in the code. You did it with LRow() so just make sure you qualify all other ranges. — BruceWayne

David David · Accepted Answer · 2016-12-04T22:49:51

The original code has an eternal loop where the loop counter rcount is repeatedly set to 11. Also, the original code was trying to delete the matched row rather than the row that we're working on... this is problematic because we're correctly working backwards up through rows so that we can delete the row we're working on and the address of subsequent rows to work on will be preserved. In the following code your loop starting For rcount = 3 To 13 has been modified: simply, for each cell pair in the matched rows, if they match then the loop continues. If the loop finishes then rcount will be 14, and row iCntr will be deleted... if the loop exits early (because a cell didn't match) then rcount will not be 14 and no row is deleted.

Dim LRow As Long, Count As Long, rcount As Long
Dim matchFoundIndex As Long
Dim matchColIndex As Variant
Dim iCntr As Long

With Sheets("Inputs")

'count the rows till which strings are there
LRow = .Cells(.Rows.Count, "B").End(xlUp).Row

 For iCntr = LRow To 1 Step -1
    Count = 0
    If .Cells(iCntr, 2) <> "" Then
        matchFoundIndex = Application.Match(.Cells(iCntr, 2), .Range("B1:B" & LRow), 0)
        If iCntr <> matchFoundIndex Then
            .Cells(iCntr, 2).Interior.ColorIndex = 3
            .Cells(matchFoundIndex, 2).Interior.ColorIndex = 3
            For rcount = 3 To 13
                If .Cells(iCntr, rcount).Value <> .Cells(matchFoundIndex, rcount).Value Then
                    Exit For
                End If
            Next rcount
            If rcount = 14 Then .Rows(iCntr).EntireRow.Delete
        End If
    End If
 Next
End With

Compare rows in a column and if match found then compare its column contents using vba

1 Answers