Find Differences (Excel 2003)

Topic

New Reply

Hi

I need to compare 2 sheets using Sheet2 as the base in the workbook and highlight all the differences in both sheet. I have the following macro from
the search I found here, how do I change it to compare all the cells in the columns which relates with the key word in column A.

I have attached a sample with the result highlight in red.

Sub FindDifferences()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim r1 As Long
Dim m1 As Long
Dim r2 As Long
Dim m2 As Long
Dim r3 As Long
Dim oCell As Range

‘ Initialize
Set ws1 = Worksheets(“Sheet1”)
m1 = ws1.Range(“A65536”).End(xlUp).Row
Set ws2 = Worksheets(“Sheet2”)
m2 = ws2.Range(“A65536”).End(xlUp).Row
Set ws3 = Worksheets(“Differences”)
r3 = 1
‘ Clear previous results
ws3.Range(“2:65536”).ClearContents

‘ Loop through the rows of month 1
For r1 = 2 To m1
‘ Can we find a matching number in month 2?
Set oCell = ws2.Range(“A:A”).Find(What:=ws1.Range(“A” & r1), _
LookIn:=xlValues, LookAt:=xlWhole)
If oCell Is Nothing Then
‘ If not, add a new row
r3 = r3 + 1
‘ Copy columns A through D
ws1.Range(“A” & r1 & “:T” & r1).Copy Destination:=ws3.Range(“A” & r3)
‘ The difference is minus the amount from month 1
ws3.Range(“F” & r3) = -ws1.Range(“E” & r1)
ElseIf Not ws1.Range(“E” & r1) = oCell.Offset(0, 4) Then
‘ If there is a match, but the amounts are different, add a new row
r3 = r3 + 1
‘ Copy columns A through D
ws1.Range(“A” & r1 & “:T” & r1).Copy Destination:=ws3.Range(“A” & r3)
‘ Also copy BC from month 2
oCell.Offset(0, 3).Copy Destination:=ws3.Range(“E” & r3)
‘ Compute the difference
ws3.Range(“F” & r3) = oCell.Offset(0, 4) – ws1.Range(“E” & r1)
End If
Next r1

‘ Loop through the rows of month 2
For r2 = 2 To m2
‘ Can we find a matching number in month 1?
Set oCell = ws1.Range(“A:A”).Find(What:=ws2.Range(“A” & r2), _
LookIn:=xlValues, LookAt:=xlWhole)
If oCell Is Nothing Then
‘ If not, add a new row
r3 = r3 + 1
‘ Copy columns A through C and E
ws2.Range(“A” & r2 & “:C” & r2).Copy Destination:=ws3.Range(“A” & r3)
ws2.Range(“E” & r2).Copy Destination:=ws3.Range(“F” & r3)
‘ The difference is the amount from month 2
ws3.Range(“F” & r3) = ws2.Range(“E” & r2)
‘ There is no Else part, for if there is a match, it has already
‘ been handled in the first loop
End If
Next r2
End Sub

Thanks

regards, francis

Reply | Quote

Replies

The code that you posted had a slightly different purpose – “missing” rows had to be copied to a third sheet, and the code also had to perform calculations. So the code you need is a bit different. See the attached text file.

Reply | Quote

I took a slightly different approach than Hans did. I did not use search, thinking that MATCH was more efficient

Steve

Option Explicit
Sub MarkDifferences()
  Dim sWks(0 To 1) As String
  Dim wksS As Worksheet
  Dim wksD As Worksheet
  Dim rMatch As Range
  Dim iCols As Integer
  Dim iCol As Integer
  Dim lRow As Long
  Dim lRows As Long
  Dim sID As String
  Dim iLoop As Integer
  Dim x As Long
  Dim AWF As WorksheetFunction
  Dim lColor As Long
   
  sWks(0) = "Sheet1"
  sWks(1) = "Sheet2"
  lColor = vbRed
  Set AWF = Application.WorksheetFunction
  For iLoop = 0 To 1
    Set wksS = Worksheets(sWks(iLoop))
    If iLoop = 0 Then
      Set wksD = Worksheets(sWks(1))
    Else
      Set wksD = Worksheets(sWks(0))
    End If
    With wksD
      Set rMatch = .Range(.Range("A1"), _
        .Cells(.Rows.Count, 1).End(xlUp))
    End With
    With wksS
      iCols = .Cells(1, .Columns.Count).End(xlToLeft).Column
      lRows = .Cells(.Rows.Count, 1).End(xlUp).Row
      .Range(.Range("A2"), .Cells(lRows, iCols)). _
        Interior.ColorIndex = xlColorIndexNone
      For lRow = 2 To lRows
        sID = .Cells(lRow, 1)
        x = 0
        On Error Resume Next
        x = AWF.Match(sID, rMatch, 0)
        On Error GoTo 0
        If x = 0 Then
          .Range(.Cells(lRow, 1), _
            .Cells(lRow, iCols)).Interior.Color = lColor
        Else
          For iCol = 2 To iCols
            If .Cells(lRow, iCol).Value  _
              wksD.Cells(x, iCol).Value Then
              .Cells(lRow, iCol).Interior.Color = lColor
            End If
          Next
        End If
      Next
    End With
  Next
  Set wksS = Nothing
  Set wksD = Nothing
  Set AWF = Nothing
End Sub

Reply | Quote

Your remark made me curious, so I did a little test. Match is indeed more efficient than Find, it is about 4 times as fast. This is definitely something to keep in mind for code that has to search thousands of times. If you call Match or Find a limited number of times, you won’t notice the difference.

Reply | Quote

I don’t know where I had heard it (or if I just presumed it, my age cataches up with me sometimes ) but I appreciate you testing it out…

Steve

Reply | Quote

Hi Hans

Thanks for your assistance.
Using Match is indeed faster as I have tested it out with my actual dataset of about 27000 rows with 20 columns.

As always Woody is the place to learn something new everytime I come.

Reply | Quote

Hi Steve and Hans

Thanks. It works perfectly!

Is it possible to produce a “Differences Report” on a third sheet showing the differences of in cell addresses with
the respective headings ( Sheet1) and (Sheet2) in columns and the Hyperlink to the highlighted rows and cells?

Thanks

Regards, francis

Reply | Quote

Hi Hans and Steve

Appreciate if you advise if this is possible to produce.

thanks

regards, francis

Reply | Quote

(Edited by sdckapr on 20-Jul-08 15:57. Put Code in File)

Does this do what you want?

Steve

Reply | Quote

Hi Steve

This is excellent. You have made it again.
I will study the codes and learn from there.

Thank you.

Reply | Quote