Debug VBA Comparing two Sheets

[adskaggs]

Hello,

I am using the following code that I found on another forum to compare two data sheets. Whenever I run the code though, it comes up with an error message "Run-time Error: 13 Type: Mismatch" for the line that is highlighted and underlined. It will highlight the differences in Excel, but will not show the pop-up message with the number of errors. Also, is there a way to only apply this code to certain cells of data instead of the whole sheet?

Thank you!



Sub RunCompare()


Call compareSheets("Sheet1", "Sheet2")


End Sub




Sub compareSheets(shtSheet1 As String, shtSheet2 As String)


Dim mycell As Range
Dim mydiffs As Integer


'For each cell in sheet2 that is not the same in Sheet1, color it yellow
For Each mycell In ActiveWorkbook.Worksheets(shtSheet2).UsedRange
If Not mycell.Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value Then

mycell.Interior.Color = vbYellow
mydiffs = mydiffs + 1

End If
Next


'Display a message box to demonstrate the differences
MsgBox mydiffs & " differences found", vbInformation


ActiveWorkbook.Sheets(shtSheet2).Select


End Sub

 

[Gingertrees]

How about this? This just checks row 1 through 3 on sheet 2. (Adjust as desired. If you want to check the whole sheet, do "For r = 1 to LastRow" )

Sub compareSheets()


Dim mycell As Range
Dim mydiffs As Integer, r As Integer, c As Integer
Dim LastRow As Integer, LastCol As Integer
LastRow = Sheets(2).UsedRange.Rows(Sheets(2).UsedRange.Rows.Count).Row
LastCol = Sheets(2).UsedRange.Columns(Sheets(2).UsedRange.Columns.Count).Column


Sheets(2).Activate
For r = 1 To 3 '//just rows 1-3; adjust as desired
    For c = 1 To LastCol
        If Sheets(2).Cells(r, c) <> Sheets(1).Cells(r, c) Then
            Sheets(2).Cells(r, c).Interior.Color = vbYellow
            If mydiffs > 0 Then
                mydiffs = mydiffs + 1
            Else: mydiffs = 1
            End If
        End If
    Next c
Next r


MsgBox "Differences found: " & mydiffs, vbInformation
Sheets(2).Activate


End Sub

BTW: this works fast for a small workbook, but you can speed it up by adding "Application.Screenupdating = false" at the top (remember to turn it back on right before "End sub" : "application.screenupdating = true")

 

[adskaggs]

Awesome! This works perfectly! Thank you so much, Gingertrees!