0

I want to compare three worksheets (which should be identical) in a workbook and highlight any non-matching cells. I've based the following code on Using VBA to compare two Excel workbooks:

Sub CompareWorksheets()

Dim varSheetA As Worksheet
Dim varSheetB As Worksheet
Dim varSheetC As Worksheet
Dim varSheetAr As Variant
Dim varSheetBr As Variant
Dim varSheetCr As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim iCol As Long

Set varSheetA = Worksheets("DS") 
Set varSheetB = Worksheets("HT") 
Set varSheetC = Worksheets("NM") 

strRangeToCheck = ("A1:L30")
' If you know the data will only be in a smaller range, reduce the size of the ranges above.

varSheetAr = varSheetA.Range(strRangeToCheck).Value
varSheetBr = varSheetB.Range(strRangeToCheck).Value
varSheetCr = varSheetC.Range(strRangeToCheck).Value ' or whatever your other sheet is.


For iRow = LBound(varSheetAr, 1) To UBound(varSheetAr, 1)
    For iCol = LBound(varSheetAr, 2) To UBound(varSheetAr, 2)
        Debug.Print iRow, iCol
        If varSheetAr(iRow, iCol) = varSheetBr(iRow, iCol) And varSheetAr(iRow, iCol) = varSheetCr(iRow, iCol) Then
          varSheetA.Cells(iRow, iCol).Interior.ColorIndex = xlNone
          varSheetB.Cells(iRow, iCol).Interior.ColorIndex = xlNone
          varSheetC.Cells(iRow, iCol).Interior.ColorIndex = xlNone
        Else
          varSheetA.Cells(iRow, iCol).Interior.ColorIndex = 22
          varSheetB.Cells(iRow, iCol).Interior.ColorIndex = 22
          varSheetC.Cells(iRow, iCol).Interior.ColorIndex = 22

        End If
    Next
Next

End Sub

The problem is, when "strRangeToCheck" starts at A1, everything works as it should, but as soon as I change the range to something like ("B4:C6"), it looks like the correct comparisons are still being made, but the cells that get highlighted always get shifted back up to cell A1 as the starting point (as opposed to B4, which is what I want). In other words, the highlighting "pattern" is correct, but shifted up and over a few cells.

TylerH
  • 20,799
  • 66
  • 75
  • 101
steve h
  • 3
  • 2

2 Answers2

1

I expanded on @Vityata example.

CompareWorksheets compares the same range on up to up to 60 Worksheets, whereas CompareRanges will compare ranges of the same size and shape.

Sub Test_Comparisons()
    CompareWorksheets "A1:L30", Worksheets("DS"), Worksheets("HT"), Worksheets("NM")
    CompareRanges Worksheets("DS").Range("A1:L30"), Worksheets("HT").Range("K11:V40"), Worksheets("NM").Range("A101:L130")
End Sub

Sub CompareWorksheets(CompareAddress As String, ParamArray arrWorkSheets() As Variant)
    Application.ScreenUpdating = False

    Dim cell As Range
    Dim x As Long
    Dim bFlag As Boolean

    'Reset all the colors
    For x = 0 To UBound(arrWorkSheets)
        arrWorkSheets(x).Range(CompareAddress).Interior.ColorIndex = xlNone
    Next

    For Each cell In arrWorkSheets(0).Range(CompareAddress)
        bFlag = False
        For x = 1 To UBound(arrWorkSheets)
            If arrWorkSheets(x).Range(cell.ADDRESS).Value <> cell.Value Then
                bFlag = True
                Exit For
            End If
        Next

        If bFlag Then
            For x = 0 To UBound(arrWorkSheets)
                arrWorkSheets(x).Range(cell.ADDRESS).Interior.ColorIndex = 22
            Next
        End If
    Next

    Application.ScreenUpdating = True
End Sub


Sub CompareRanges(ParamArray arrRanges() As Variant)
    Application.ScreenUpdating = False

    Dim cell As Range
    Dim x As Long, y As Long, z As Long
    Dim bFlag As Boolean

    'Reset all the colors
    For z = 0 To UBound(arrRanges)
        arrRanges(z).Interior.ColorIndex = xlNone
    Next

    For x = 1 To arrRanges(0).Rows.Count
        For y = 1 To arrRanges(0).Rows.Count
            For z = 1 To UBound(arrWorkSheets)
                If arrWorkSheets(1).Cells(x, y).Value <> arrWorkSheets(z).Cells(x, y).Value Then
                    bFlag = True
                    Exit For
                End If
            Next
            If bFlag Then
                For z = 0 To UBound(arrWorkSheets)
                    arrWorkSheets(z).Cells(x, y).Interior.ColorIndex = 22
                Next
            End If
        Next
    Next

    Application.ScreenUpdating = True
End Sub
0

What I have understood from the first reading, is that you have 3 worksheets which you want to compare. This code works, if you want to compare a selected range in the first three worksheets in a workbook. It colors the different values in red, in each workbook:

Option Explicit

Sub compareWorksheets()

    Dim rngCell As Range
    Dim counter As Long

    For Each rngCell In Selection

       If Worksheets(1).Range(rngCell.Address) <> Worksheets(2).Range(rngCell.Address) _
       Or Worksheets(1).Range(rngCell.Address) <> Worksheets(3).Range(rngCell.Address) Then
            For counter = 1 To 3
                Worksheets(counter).Range(rngCell.Address).Interior.Color = vbRed
            Next counter
       End If

    Next rngCell

End Sub

If you want to compare a range A1:Z10 in the three worksheets, change the words Selection with Worksheets(1).Range("A1:Z10") or simply select the range in a one workbook.

Vityata
  • 42,633
  • 8
  • 55
  • 100