VBA Compare 2 arrays loop >> highlight and copy differences to a 3rd column

Question

I've a question similar to the one on the post VBA macro to compare two columns and color highlight cell differences.

I used it as reference point, but now I'm stuck for hours solving my case. Code included below, I'll explain my case first for better understanding and to be easier to follow.

Case: I've the following Worksheet before any manipulation. I'm comparing the columns "A:B" and "D:E", etc (from row 3 until the last used row). See the screenshot below for a better visualization (this is just part of the data).

Now I would like to see 2 actions performed:

1. Highlight the cells in A column and D column that are not part of the B and E column - I'll refer to these cells as errors
2. Copy the value of the errors (highlighted cell (from A and D)) into the C and F column (this is the "Review column" - which is always 2 columns to the right in relation to the initial column)

See the screenshot below for a better visualization

CODE:

Sub compare_cols()

    Dim Report As Worksheet
    Dim i As Integer, j As Integer
    Dim lastRow As Integer

    Set Report = Excel.Worksheets("Check_Sheet")

    lastRow = 80

    arrInputCheckSheet= Array("A", "D", "G", "J", "M", "P", "S", "V", "Y") 'I will use these columns to compare against the next array
    arrMDCheckSheet = Array("B", "E", "H", "K", "N", "Q", "T", "W", "Z") 'I will use these columns as reference 


    Application.ScreenUpdating = False

    For a = LBound(arrInputCheckSheet) To UBound(arrInputCheckSheet)
        For i = 3 To lastRow
            For j = 3 To lastRow
                If Report.Cells(i, arrInputCheckSheet(a)).Value <> "" Then 'This will omit blank cells at the end (in the event that the column lengths are not equal.
                    If InStr(1, Report.Cells(j, arrMDCheckSheet(a)).Value, Report.Cells(i, arrInputCheckSheet(a)).Value, vbTextCompare) > 0 Then 
                        Report.Cells(i, arrInputCheckSheet(a)).Interior.Color = RGB(156, 0, 6) 'Dark red background
                        Report.Cells(i, arrInputCheckSheet(a)).Font.Color = RGB(255, 199, 206) 'Light red font color
                        Exit For
                    Else
                  End If
                End If
            Next j
        Next i
    Next a

Application.ScreenUpdating = True

End Sub

Problem:

1. I'm trying to highlight the error cells with dark red background. but this code is doing exactly the opposite (is highlighting the values that match).
2. How can I make the error value (the one that gets highlighted) appear in the the "check column".

I really appreciate any suggestion and support you can give to me

Thank you very much and have a nice day

Answer 1

I suggest to use the WorksheetFunction.Match Method instead of that second j loop. And use the Range.Offset Property to address the offset cell to copy the value.

Here is an example for the data shown in your screenshot.

Option Explicit

Sub compare_cols()
    Dim Report As Worksheet
    Set Report = Excel.Worksheets("Check_Sheet")

    Dim lastRow As Long
    lastRow = 10

    Dim arrInputCheckSheet As Variant
    arrInputCheckSheet = Array("A", "D") 'I will use these columns to compare against the next array

    Dim arrMDCheckSheet As Variant
    arrMDCheckSheet = Array("B", "E") 'I will use these columns as reference

    Dim j As Long
    j = 13 'start at row 13

    'Application.ScreenUpdating = False 'disable this during debug
    Const firstRow As Long = 3
    Dim a As Long
    For a = LBound(arrInputCheckSheet) To UBound(arrInputCheckSheet)
        Dim i As Long
        For i = firstRow To lastRow
            Dim MatchRow As Long
            If Report.Cells(i, arrInputCheckSheet(a)).Value <> vbNullString Then 'This will omit blank cells at the end (in the event that the column lengths are not equal.

                On Error Resume Next 'match throws an error if nothing matched
                MatchRow = 0
                MatchRow = Application.WorksheetFunction.Match(Report.Cells(i, arrInputCheckSheet(a)).Value, Report.Range(Cells(firstRow, arrMDCheckSheet(a)), Cells(lastRow, arrMDCheckSheet(a))), 0)
                On Error GoTo 0 're-activate error reporting

                If MatchRow = 0 Then
                    'no match
                    With Report.Cells(i, arrInputCheckSheet(a))
                        .Interior.Color = RGB(156, 0, 6) 'Dark red background
                        .Font.Color = RGB(255, 199, 206) 'Light red font color

                        .Offset(0, 2).Value = .Value 'copy value

                        'copy to different sheet
                        Sheets("Check_Sheet").Cells(j, arrControlSheet(a)) = .Value
                        j = j + 1 'increase row counter after each copy
                    End With
                End If
            End If

        Next i
    Next a

    'Application.ScreenUpdating = True
End Sub

Answer 2

As mentioned in the comments, you need to check if the InStr function returns zero (see the MSDN page on InStr), not greater than zero. Note that using InStr will match partial matches too (if you have "a" in column A, that will match with any string in column B that contains "a"). If you want more exact matches use = or the Like keyword (in conjunction with something like the UCASE function to match across cases). However, the reason that alone will not work is that it does this if the A column cell is not equal to ALL of the column B cells. It checks against the first one, if it isn't equal to that it gets highlight, and on to the second entry in row A to repeat. You need an If-Else to do something if it does match, and you will need to check every entry (the exit for statement needs to go in the case where there IS a match). To copy your highlighted cells into column C, F, etc... you can offset two columns from your current A column when inside the inner If statement.

If UCase(Report.Cells(j, arrMDCheckSheet(a)).Value) Like UCase(Report.Cells(i, arrInputCheckSheet(a)).Value) Then
    Report.Cells(i, arrInputCheckSheet(a)).ClearFormatting
    Exit For
Else
    Report.Cells(i, arrInputCheckSheet(a)).Interior.Color = RGB(156, 0, 6) 'Dark red background
    Report.Cells(i, arrInputCheckSheet(a)).Font.Color = RGB(255, 199, 206) 'Light red font color
    Report.Cells(i, arrInputCheckSheet(a)).Offset(0,2).Value = Report.Cells(i, arrInputCheckSheet(a)).Value  ' This copies to the 3rd column
End If

Or using InStr:

If InStr(1,Report.Cells(j, arrMDCheckSheet(a)).Value,Report.Cells(i, arrInputCheckSheet(a)).Value) = 0 Then

It would also be quicker to use a while statement instead of the for loops to keep going until a blank cell is encountered so that you don't keep checking blank cells.

i = 3
Do While Report.Cells(i, arrInputCheckSheet(a)).Value <> ""
    j = 3
    Do While Report.Cells(j, arrMDCheckSheet(a)).Value <> ""
        ' this would be the if statements, use exit do instead of exit for
        j = j + 1
    Loop
    i = i + 1
Loop

Answer 3

Another possibility; make a string of your arrMDCheckSheet-array (I changed the Instr function and added one line for third column, to keep your original code as much as it is)

    For a = LBound(arrInputCheckSheet) To UBound(arrInputCheckSheet)
    For i = 3 To lastRow
        For j = 3 To lastRow
            If Report.Cells(i, arrInputCheckSheet(a)).Value <> "" Then 'This will omit blank cells at the end (in the event that the column lengths are not equal.
                If InStr(1, Join(Application.Transpose(Report.Range(Cells(3, arrMDCheckSheet(a)), Cells(lastRow, arrMDCheckSheet(a)))), "|"), Report.Cells(i, arrInputCheckSheet(a)).Value, vbTextCompare) = 0 Then
                    Report.Cells(i, arrInputCheckSheet(a)).Interior.Color = RGB(156, 0, 6) 'Dark red background
                    Report.Cells(i, arrInputCheckSheet(a)).Font.Color = RGB(255, 199, 206) 'Light red font color
                    Report.Cells(i, arrInputCheckSheet(a)).Offset(, 2) = Report.Cells(i, arrInputCheckSheet(a)) 'added
                    Exit For
                Else
              End If
            End If
        Next j
    Next i
Next a