CODEWITHSUNDEEP
vbaexcel
joes
joes

Reputation: 31

Format mismatching cells in VBA worksheet comparison macro

Quick question, below is code snippet of a comparison program that checks two worksheets to find mismatching data. I would like to highlight or format the mismatching cells on the sheet4 but am running into syntax or maybe logic trouble. Any guidance would be greatly appreciated.

Option Explicit

Sub compare2WorkSheets()
Dim varSheetA As Variant, varSheetB As Variant
Dim strRangeToCheck As String
Dim iRow As Long, iCol As Long

strRangeToCheck = "A1:AB17000"

Debug.Print Now
varSheetA = Worksheets("Sheet3").Range(strRangeToCheck)
varSheetB = Worksheets("Sheet4").Range(strRangeToCheck)
Debug.Print Now

For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
    For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
        If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then
            ' matching cells no format
        Else
            ' mismatch found,format the Sheet4 cells to yellow
            varSheetB(iRow, iCol).Interior.Color = vbYellow '...referencing syntax trouble
        End If
    Next iCol
Next iRow

End Sub

Upvotes: 1

Views: 164

Answers (2)

Tim Williams
Tim Williams

Reputation: 166341

Another approach:

Sub CompareRanges()

    Dim rngA As Range, rngB As Range, arr, r As Long, c As Long

    Set rngA = Range("A1:D4")
    Set rngB = Range("A6:D9")
    'will be evaluated as an array formula
    arr = ActiveSheet.Evaluate("=IF(" & rngA.Address & "=" & rngB.Address & ",1,0)")

    For r = LBound(arr, 1) To UBound(arr, 1)
    For c = LBound(arr, 2) To UBound(arr, 2)
        If Not IsError(arr(r, c)) Then
            rngA(r, c).Interior.Color = IIf(arr(r, c) = 0, vbYellow, vbWhite)
        End If
    Next c
    Next r

End Sub

Upvotes: 1

Dan
Dan

Reputation: 435

Here is a different approach that I typically use when trying to find and highlight mismatches. This should have the functionality you're looking for.

Option Explicit

Sub Compare2worksheets()

Dim iCol, iRow As Integer

For iCol = 1 To 27
    For iRow = 1 To 17000
        If Worksheets("Sheet3").Cells(iRow, iCol) = Worksheets("Sheet4").Cells(iRow, iCol) Then
        'Do Nothing
        Else
        Worksheets("Sheet4").Cells(iRow, iCol).Interior.Color = vbYellow
        End If
    Next iRow
Next iCol

End Sub

Upvotes: 0

Related Questions