[VBA] Compare two worksheets and paste results in a third one

[Oceanborn]

Hello,

I am a VBA - and programming in general - newbie and I would like to make a macro that compares two worksheets, highlights the differences, and paste the whole row in a third worksheet if a difference is found.

I managed to highlight the difference between two sheets using the following code. But i am having a hard time figuring out how to modify it to paste the differences in a third sheet...can anyone help ? Thanks !

Sub Compare()
  CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")
End Sub

Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
  Dim diffB As Boolean
  Dim r As Long, c As Integer
  Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
  Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String


  With ws1.UsedRange
    lr1 = .Rows.Count
    lc1 = .Columns.Count
  End With
  With ws2.UsedRange
    lr2 = .Rows.Count
    lc2 = .Columns.Count
  End With
  maxR = lr1
  maxC = lc1
  If maxR < lr2 Then maxR = lr2
  If maxC < lc2 Then maxC = lc2
  DiffCount = 0
  For c = 1 To maxC
    For i = 2 To maxR
          On Error Resume Next
          cf1 = ws1.Cells(i, c)
          cf2 = ws2.Cells(i, c)
          On Error GoTo 0
          If cf1 = cf2 Then
            ws1.Cells(i, c).Select
            Selection.Font.Bold = False
          End If
 
     If cf1 <> cf2 Then
       ws1.Cells(i, c).Select
       Selection.Font.Bold = True
     End If
    Next i
  Next c
End Sub

 

[hippiehacker]

try

Sub Compare()
  CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")
End Sub

Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
  Dim diffB As Boolean
  Dim r As Long, c As Integer
  Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
  Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
  Dim ws3 As Worksheet
  
  Set ws3 = Worksheets("Sheet3")


  With ws1.UsedRange
    lr1 = .Rows.Count
    lc1 = .Columns.Count
  End With
  With ws2.UsedRange
    lr2 = .Rows.Count
    lc2 = .Columns.Count
  End With
  maxR = lr1
  maxC = lc1
  If maxR < lr2 Then maxR = lr2
  If maxC < lc2 Then maxC = lc2
  DiffCount = 0
  For c = 1 To maxC
    For i = 2 To maxR
          On Error Resume Next
          cf1 = ws1.Cells(i, c)
          cf2 = ws2.Cells(i, c)
          On Error GoTo 0
          If cf1 = cf2 Then
            ws1.Cells(i, c).Font.Bold = False
          End If
 
     If cf1 <> cf2 Then
       ws1.Cells(i, c).Font.Bold = True
       ws1.Cells(i, c).EntireRow.Copy ws3.Range("A" & ws3.Range("A" & Rows.Count).End(xlUp).Row + 1)
     End If
    Next i
  Next c
End Sub

 

[Oceanborn]

Thanks, it works ! Though i don't really understand why it does...maybe you can stop me where i'm wrong ?

 ws3.Range("A" & ws3.Range("A" & Rows.Count).End(xlUp).Row + 1)

"A" & ws3.Range("A" & Rows.Count)" => This is the last non-empty cell in the A column
.End(xlUp) => Top cell in the A column...which is A1 ?!
.Row => Number of that row, which is 1 ??
+1 => 2 so to me it's basically like writing Range(A2) ?

I must be wrong - since it works fine - but i'd like to understand where. Thanks !!

 

[Oceanborn]

 

[Oceanborn]

Ok I found my mistake - i think - end(Xlup) yields the last used cell in that direction and not the last cell !