Compare two worksheets

[josros60]

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:

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,

 

[Drrellik]

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

 

[Mentor82]

Hi,
How about this?

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

 

[DanteAmor]

Try this

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

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

 

[DanteAmor]

Another approach

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

 

[tico_ocit]

Try this

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

Ya, that was the first think my eyes catched. Nice work.