VBA - compare the cells in two columns with the cells in two other columns

Question

I have searched far and wide without finding a good answer for this issue.

I have two lists with two columns in each. The lists contains dealer numbers (column A) and part numbers for the dealers (column B). The same value may be duplicate in each of the columns (each dealer has several part numbers and each part number may occur for several dealers).

I want the script to start with A1 and B1 in sheet1, check if both cells have a match in sheet2 - column A and column B and if so mark the equivalent cell in A1 as red, and then move to A2 + B2 to do the same comparison again. In other words, it should check row1 in sheet 1, compare it with each row in Sheet2 for a match, mark the A-cell in Sheet1 red if there is a match, and then move to the next row in Sheet1.

Here is where i have problems getting it right; I cannot seem to make the script flexible. My script does not seem to check both Cell A and B in Sheet1 and it does not check the full range in Sheet 2 for each loop.

In the next step I would also want the script to check if a third column in Sheet2 is higher than the respective cell in Sheet1, but I should be able to handle that once I get the basics going.

Here's how my code looks now:

Sub Comparestwocolumns()

Dim i As Long
Dim lastrow As Long
Dim ws As Worksheet

Set ws = Sheet1
Set ws2 = Sheet2

For i = 1 To 500000

If IsEmpty(ws.Range("A" & i)) = True Then
    Exit For
End If
For j = 1 To 500000

If IsEmpty(ws2.Range("A" & j)) = True Then
       Exit For
       End If


If ws.Range("A" & i).Value = ws2.Range("A" & j).Value Then

If ws.Range("A" & i).Offset(0, 1).Value = ws2.Range("A" & j).Offset(0,   1).Value Then

                ws.Range("A" & i).Interior.Color = vbRed
            Else

                ws.Range("A" & i).Interior.Color = vbWhite

            End If

            Exit For
            End If

Next j
Next i
MsgBox ("Finished ")
End Sub

Thank you!

Answer 1

Close, so close.

Most of the changes I made to your code were "cosmetic" (e.g. using "B" instead of offsetting one column from "A").

The main change is the If statement. After the "cosmetic" changes, your If statement ended up looking like:

If ws.Range("A" & i).Value = ws2.Range("A" & j).Value Then
    If ws.Range("B" & i).Value = ws2.Range("B" & j).Value Then
        ws.Range("A" & i).Interior.Color = vbRed
    End If
    Exit For
End If

The problem is that that exits the For j loop as soon as the values in column A match, even if the values in column B didn't match. The Exit For needs to only be executed once both column A and column B match, e.g.

If ws.Range("A" & i).Value = ws2.Range("A" & j).Value Then
    If ws.Range("B" & i).Value = ws2.Range("B" & j).Value Then
        ws.Range("A" & i).Interior.Color = vbRed
        Exit For
    End If
End If

---

The final code, after all my changes, ends up as:

Sub Comparestwocolumns()

    Dim i As Long
    Dim j As Long
    Dim lastrow As Long
    Dim ws As Worksheet

    Set ws = Sheet1
    Set ws2 = Sheet2

    For i = 1 To 500000
        If IsEmpty(ws.Range("A" & i)) Then
            Exit For
        End If

        For j = 1 To 500000
            If IsEmpty(ws2.Range("A" & j)) Then
                Exit For
            End If

            If ws.Range("A" & i).Value = ws2.Range("A" & j).Value Then
                If ws.Range("B" & i).Value = ws2.Range("B" & j).Value Then
                    ws.Range("A" & i).Interior.Color = vbRed
                    Exit For
                End If
            End If
        Next j
    Next i
    MsgBox ("Finished ")
End Sub

Answer 2

to loop until you have data on your sheets:

Option Explicit
Sub matcher()

    Dim i As Integer, j As Integer

    i = 1
    While Sheets(1).Cells(i, 1).Value <> ""
        j = 1
        While Sheets(2).Cells(j, 1).Value <> ""

            If Sheets(1).Cells(i, 1).Value = Sheets(2).Cells(j, 1).Value And Sheets(1).Cells(i, 2).Value = Sheets(2).Cells(j, 2).Value Then
                Sheets(1).Cells(i, 1).Interior.ColorIndex = 3
            End If

            j = j + 1
        Wend
        i = i + 1
    Wend
End Sub

Answer 3

you can use AutoFilter():

Option Explicit

Sub Comparestwocolumns()
    Dim firstShtRng  As Range, filteredRng As Range, colorRng As Range, cell As Range

    With Worksheets("Sheet2") '<--| reference your 2nd sheet
        Set firstShtRng = .Range("A1", .cells(.Rows.Count, 1).End(xlUp)) '<--| gather its column A values from row 1 down to last not empty row to be checked in 2nd sheet
    End With

    With Sheets("Sheet1") '<--| reference your 1st sheet
        With .Range("A1", .cells(.Rows.Count, 1).End(xlUp)) '<--| reference its column A range from row 1 down to last not empty row
            .AutoFilter Field:=1, Criteria1:=Application.Transpose(firstShtRng.Value), Operator:=xlFilterValues '<--| filter referenced cells with 'firstShtRng' values
            Set filteredRng = .SpecialCells(xlCellTypeVisible) '<--| set filtered cells to 'filteredRng' range
            Set colorRng = .Offset(, 1).Resize(1, 1) '<--| initialize 'colorRng' to a "dummy" cell that's out of range of interest: it'll be used to avoid subsequent checking against "nothing" before calling 'Union()' method and eventually discharged
        End With
        .AutoFilterMode = False
    End With

    For Each cell In filteredRng '<--| loop through filtered cells in "Sheet1"
        If firstShtRng.Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole).Offset(, 1) = cell.Offset(, 1) Then Set colorRng = Union(colorRng, cell) '<--| if current cell adjacent value matches corresponding value in "Sheet2" then update 'colorRng'
    Next
    Set colorRng = Intersect(filteredRng, colorRng) '<--| get rid of "dummy" cell
    If Not colorRng Is Nothing Then colorRng.Interior.Color = vbRed '<--| if any survived cell in "Sheet1" then delete corresponding rows
End Sub