Help-- Need a macro that will compare two spreadsheets and highlight changes

[tvjanes45]

Hello

I have two spreadsheets that I need to compare and identify any differences. I was using the below macro however, this macro didn't account for any new items was add each quarter. I need help writing a macro that will compare the spreadsheets, highlight and skip to the line if not found and continue search.

Sub RunCompare()

Call compareSheets("Before", "After")

End Sub


Sub compareSheets(shtBefore As String, shtAfter As String)

Dim mycell As Range
Dim mydiffs As Integer

For Each mycell In ActiveWorkbook.Worksheets(shtAfter).UsedRange
If Not mycell.Value = ActiveWorkbook.Worksheets(shtBefore).Cells(mycell.row, mycell.Column).Value Then

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

End If
Next

MsgBox mydiffs & " differences found", vbInformation

ActiveWorkbook.Sheets(shtAfter).Select

End Sub

 

[tvjanes45]

Hey mumps.. Can I ask for one more thing? Can you write comments within the code to state what's happening with each step? This is to educate me and help me in the future. Thanks

 

[mumps]

When adding the comments, I noticed a couple of errors in my original code. Please use the revised version below:

Sub CompareVals()
    Application.ScreenUpdating = False 'prevents screen flickering and speeds up macro
    Dim GL As Range, RngList As Object, rng As Range
    Set RngList = CreateObject("Scripting.Dictionary")
    Dim foundGL As Range
    Dim LastRow2 As Long
    Dim LastRow As Long
    LastRow = Sheets("Sheet2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'row number of last used row in Sheet2
    For Each GL In Sheets("Sheet2").Range("A2:A" & LastRow) 'loops through all GL values in column A, Sheet2
        Set foundGL = Sheets("Sheet1").Range("A:A").Find(GL, LookIn:=xlValues, lookat:=xlWhole) 'searches for GL values in column A of Sheet1
        If Not foundGL Is Nothing Then 'if GL is found, executes following 'For...Next loops
            For Each rng In Sheets("Sheet1").Range("A" & foundGL.Row & ":G" & foundGL.Row) 'loops through values in A:G in row of found GL
                If Not RngList.Exists(rng.Value) Then 'checks if each value in row exists in dicitonary
                    RngList.Add rng.Value, Nothing 'if it doesn't exist, the value is added to dicitionary
                End If
            Next rng
            For Each rng In Sheets("Sheet2").Range("A" & GL.Row & ":G" & GL.Row) 'loops through values in A:G in row of GL
                If Not RngList.Exists(rng.Value) Then 'checks if each value in row exists in dicitonary
                    rng.Interior.ColorIndex = 6 'if it doesn't exist, that cell is colored yellow
                End If
            Next rng
        Else
            GL.EntireRow.Interior.ColorIndex = 3 'if GL from column A, Sheet2 is not found in column A, Sheet1, that row is colored in red
        End If
        RngList.RemoveAll 'clears dictionary to receive values from next row
    Next GL
    LastRow2 = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'row number of last used row in Sheet1
    For Each GL In Sheets("Sheet1").Range("A2:A" & LastRow2) 'loops through all GL values in column A, Sheet1
        Set foundGL = Sheets("Sheet2").Range("A:A").Find(GL, LookIn:=xlValues, lookat:=xlWhole) 'searches for GL values in column A of Sheet2
        If foundGL Is Nothing Then 'if GL is not found in column A, Sheet2, executes next line
            GL.EntireRow.Interior.ColorIndex = 3 'colors row in Sheet1
        End If
    Next GL
End Sub

You can delete the comments if you wish.

 

[tvjanes45]

Thanks it worked.

I have tried to add mutliple sheets to the code and receive a error 450 wrong number of arguments

Sub CompareVals()
Application.ScreenUpdating = False 'prevents screen flickering and speeds up macro
Dim GL As Range, RngList As Object, rng As Range
Set RngList = CreateObject("Scripting.Dictionary")
Dim foundGL As Range
Dim LastRow2 As Long
Dim LastRow As Long
LastRow = Sheets("CurrentQtr_BS", "CurrentQtr_SNC", "CurrentQtr_SCNP", "CurrentQtr_SBR").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row 'row number of last used row in Sheet2
For Each GL In Sheets("CurrentQtr_BS", "CurrentQtr_SNC", "CurrentQtr_SCNP", "CurrentQtr_SBR").Range("A2:A" & LastRow) 'loops through all GL values in column A, Sheet2
Set foundGL = Sheets("PriorQtr_BS", "PriorQtr_SNC", "PriorQtr_SCNP", "PriorQtr_SBR").Range("A:A").Find(GL, LookIn:=xlValues, lookat:=xlWhole) 'searches for GL values in column A of Sheet1
If Not foundGL Is Nothing Then 'if GL is found, executes following 'For...Next loops
For Each rng In Sheets("PriorQtr_BS", "PriorQtr_SNC", "PriorQtr_SCNP", "PriorQtr_SBR").Range("A" & foundGL.row & ":G" & foundGL.row) 'loops through values in A:G in row of found GL
If Not RngList.Exists(rng.Value) Then 'checks if each value in row exists in dicitonary
RngList.Add rng.Value, Nothing 'if it doesn't exist, the value is added to dicitionary
End If
Next rng
For Each rng In Sheets("CurrentQtr_BS", "CurrentQtr_SNC", "CurrentQtr_SCNP", "CurrentQtr_SBR").Range("A" & GL.row & ":G" & GL.row) 'loops through values in A:G in row of GL
If Not RngList.Exists(rng.Value) Then 'checks if each value in row exists in dicitonary
rng.Interior.ColorIndex = 23 'if it doesn't exist, that cell is colored yellow
End If
Next rng
Else
GL.EntireRow.Interior.ColorIndex = 15 'if GL from column A, Sheet2 is not found in column A, Sheet1, that row is colored in red
End If
RngList.RemoveAll 'clears dictionary to receive values from next row
Next GL
LastRow2 = Sheets("PriorQtr_BS", "PriorQtr_SNC", "PriorQtr_SCNP", "PriorQtr_SBR").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row 'row number of last used row in Sheet1
For Each GL In Sheets("PriorQtr_BS", "PriorQtr_SNC", "PriorQtr_SCNP", "PriorQtr_SBR").Range("A2:A" & LastRow2) 'loops through all GL values in column A, Sheet1
Set foundGL = Sheets("CurrentQtr_BS", "CurrentQtr_SNC", "CurrentQtr_SCNP", "CurrentQtr_SBR").Range("A:A").Find(GL, LookIn:=xlValues, lookat:=xlWhole) 'searches for GL values in column A of Sheet2
If foundGL Is Nothing Then 'if GL is not found in column A, Sheet2, executes next line
GL.EntireRow.Interior.ColorIndex = 6 'colors row in Sheet1
End If
Next GL
MsgBox mydiffs & " differences found", vbInformation
End Sub

 

[mumps]

Are you saying that you want to run the macro on these four sheets: "CurrentQtr_BS", "CurrentQtr_SNC", "CurrentQtr_SCNP", "CurrentQtr_SBR"

 

[tvjanes45]

Are you saying that you want to run the macro on these four sheets: "CurrentQtr_BS", "CurrentQtr_SNC", "CurrentQtr_SCNP", "CurrentQtr_SBR"

Response: yes you your correct. Each one of those sheets is going to compare itself to the PriorQtr_BS....etc

 

[mumps]

I think that it would be much easier to follow and to test the macro if I could see how your data is organized. Perhaps you could upload a copy of your file to a free site such as www.box.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells and worksheets.