Compare two worksheets

josros60

Well-known Member
Joined
Jun 27, 2010
Messages
778
Office Version
  1. 365
Hi,

I have the code below but not working want to find difference between JAN/JUL tabs both column A but not working I kow there's a difference because one has 316 rows and the other one 315 then there's one line missing in JUL tab has only 315.

here is the code:

Code:
Sub compare()  Dim myRng As Range
    Dim lastCell As Long
Dim mydiffs As Integer
    'Get the last row
    Dim lastRow As Integer
    lastRow = ActiveSheet.UsedRange.Rows.Count


    'Debug.Print "Last Row is " & lastRow


    Dim c As Range
    Dim d As Range


    Application.ScreenUpdating = False


    For Each c In Worksheets("JAN").Range("A3:A" & lastRow).Cells
        For Each d In Worksheets("JUL").Range("A3:A" & lastRow).Cells
            c.Interior.Color = vbRed
            If (InStr(1, d, c, 1) > 0) Then
                c.Interior.Color = vbWhite
                Exit For
            End If
        Next
    Next


    For Each c In Worksheets("JUL").Range("A3:A" & lastRow).Cells
        For Each d In Worksheets("JAN").Range("A3:A" & lastRow).Cells
            c.Interior.Color = vbRed
            If (InStr(1, d, c, 1) > 0) Then
                c.Interior.Color = vbWhite
                Exit For
            End If
        Next
    Next


'Display a message box to demonstrate the differences
MsgBox mydiffs & " differences found", vbInformation
Application.ScreenUpdating = True


End Sub


thanks,
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Im not real good with VBA bur looking at your code and going back to my MS DOS days I see you are using c & d for both, if you are looking to for/next count data and make it equal to c twice in the same sub wont that cause a problem. not real sure here just wondering. hope that makes sense.

~DR
 
Upvote 0
Hi,
How about this?
Code:
Sub compare() 
    Dim myRng As Range
    Dim lastCell As Long
    Dim mydiffs As Integer
    'Get the last row
    Dim lastRow As Integer
    Dim bool_recFound as boolean
    lastRow = ActiveSheet.UsedRange.Rows.Count
    'Debug.Print "Last Row is " & lastRow

    Dim c As Range
    Dim d As Range


    Application.ScreenUpdating = False


    For Each c In Worksheets("JAN").Range("A3:A" & lastRow)
        For Each d In Worksheets("JUL").Range("A3:A" & lastRow)
           bool_recFound=false
            If d.value =c.value then
                bool_recFound=true
                Exit For
            End If
        Next
        If bool_recFound=true then
             c.Interior.Color = vbWhite
        else
             c.Interior.Color = vbRed
             mydiffs=mydiffs+1
        End if
    Next

    For Each c In Worksheets("JUL").Range("A3:A" & lastRow)
        bool_recFound=false

        For Each d In Worksheets("JAN").Range("A3:A" & lastRow)

            If d.value=c.value Then
                bool_recFound=true
                Exit For
            End If
        Next
        If bool_recFound=true then
             c.Interior.Color = vbWhite
        else
             c.Interior.Color = vbRed
             mydiffs=mydiffs+1
        End if
    Next

'Display a message box to demonstrate the differences
MsgBox mydiffs & " differences found", vbInformation
Application.ScreenUpdating = True

End Sub
 
Upvote 0
Try this

Maybe the number of rows in Jul is not the same as in Jan, for that you need 2 variables

Code:
Sub compare()
  Dim myRng As Range
  Dim lastCell As Long
  Dim mydiffs As Integer
    'Get the last row
  Dim lastRow1 As Long, lastRow2 As Long
[COLOR=#0000ff]  lastRow1 = Sheets("Jan").Range("A" & Rows.Count).End(xlUp).Row[/COLOR]
[COLOR=#0000ff]  lastRow2 = Sheets("Jul").Range("A" & Rows.Count).End(xlUp).Row[/COLOR]
  Dim c As Range
  Dim d As Range
  Application.ScreenUpdating = False
  For Each c In Worksheets("JAN").Range("A3:A" & lastRow1).Cells
      For Each d In Worksheets("JUL").Range("A3:A" & lastRow2).Cells
          c.Interior.Color = vbRed
          If (InStr(1, d, c, 1) > 0) Then
              c.Interior.Color = vbWhite
              Exit For
          End If
      Next
      If c.Interior.Color = vbRed Then mydiffs = mydiffs + 1
  Next
  For Each c In Worksheets("JUL").Range("A3:A" & lastRow2).Cells
      For Each d In Worksheets("JAN").Range("A3:A" & lastRow1).Cells
          c.Interior.Color = vbRed
          If (InStr(1, d, c, 1) > 0) Then
              c.Interior.Color = vbWhite
              Exit For
          End If
      Next
      If c.Interior.Color = vbRed Then mydiffs = mydiffs + 1
  Next
  'Display a message box to demonstrate the differences
  MsgBox mydiffs & " differences found", vbInformation
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Another approach

Code:
Sub compare_sheets()
  Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, f As Range, mydiffs As Long
  Dim r1 As Range, r2 As Range
  Set sh1 = Sheets("Jan")
  Set sh2 = Sheets("Jul")
  Set r1 = sh1.Range("A3", sh1.Range("A" & Rows.Count).End(xlUp))
  Set r2 = sh2.Range("A3", sh2.Range("A" & Rows.Count).End(xlUp))
  r1.Interior.Color = vbWhite
  r2.Interior.Color = vbWhite
  
  For Each c In r1
    Set f = r2.Find(c, , xlValues, xlWhole)
    If f Is Nothing Then
      c.Interior.Color = vbRed
      mydiffs = mydiffs + 1
    End If
  Next
  For Each c In r2
    Set f = r1.Find(c, , xlValues, xlWhole)
    If f Is Nothing Then
      c.Interior.Color = vbRed
      mydiffs = mydiffs + 1
    End If
  Next
  MsgBox mydiffs & " differences found"
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,186
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top