Macro to compare two excel sheets

annajins - Updated on Dec 20, 2018 at 03:06 PM
 Aks - Aug 2, 2012 at 04:58 AM

I need help to write macro to compare two sheets, sheet1 and sheet2 on same excel book and display the result on the third sheet.

The number of rows and columns may not be equal and it can vary each time. So, we need to find the range of columns and rows first. I am struggling with this.

I tried the following code to compare the values,
Sub Macro7()
' Macro7 Macro
' Macro recorded 12/11/2008 by UBOC User
ActiveCell.FormulaR1C1 = _
Selection.AutoFill Destination:=Range("A2:EG2"), Type:=xlFillDefault
Selection.AutoFill Destination:=Range("A2:EG1614"), Type:=xlFillDefault
End Sub

But here I don't know how to get the Range dynamically and implement it in this macro.

3 responses

kish1975 Posts 12 Registration date Wednesday March 3, 2010 Status Member Last seen March 22, 2010 7
Updated on Dec 14, 2018 at 03:57 AM
Check this macro

Sub test()
Dim rng As Range, c As Range, cfind As Range
On Error Resume Next
With Worksheets("sheet1")
Set rng = Range(.Range("A2"), .Range("a2").End(xlDown))
For Each c In rng
With Worksheets("sheet2")
Set cfind = .Columns("A:A").Cells.Find _
    (what:=c.Value, lookat:=xlWhole)
If cfind Is Nothing Then GoTo line1
'c.EntireRow.Copy Worksheets("sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
c.Copy Worksheets("sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
c.Offset(0, 2).Copy Worksheets("sheet3").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)

End With 'sheet 2
Next c
Application.CutCopyMode = False
End With 'sheet 1

End Sub
hey hi there can any one tell me where to add this macro in VBA
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Dec 8, 2011 at 12:02 PM
@Roxy "hey hi there can any one tell me where to add this macro in VBA"

Open workbook
press alt + f11 at same time
click on insert and add a new module
paste the code

press f5 to run the macro
i am using the following code to compare two worksheets. The code is working fine. the differences are highlighted. I need a code that if I rectify the diferences in one of the sheets, the previously highlighted cells should return to normal. can somebody help me on this please?

the code is:

Sub All_Diffs_Highlighted()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Cell As Range
Dim sBook As String
If Workbooks.Count < 2 Then
MsgBox "Error: Only one Workbook is open" & vbCr & _
"Open a 2nd Workbook and run this macro again."
Exit Sub
End If
Set wb1 = ThisWorkbook
For Each wb2 In Workbooks
If wb2.Name <> wb1.Name Then Exit For
On Error Resume Next
Application.DisplayAlerts = False
sBook = Application.InputBox(Prompt:= _
"Compare this workbook (" & wb1.Name & _
") to...?", _
Title:="Compare to what workbook?", _
Default:=wb2.Name, _
If sBook = "False" Then Exit Sub
If Workbooks(sBook) Is Nothing Then
MsgBox "Workbook: " & sBook & " is not open."
GoTo ReDo1
Set wb2 = Workbooks(sBook)
End If
Application.ScreenUpdating = False
For Each ws1 In wb1.Sheets
If Not wb2.Sheets(ws1.Name) Is Nothing Then
Set ws2 = wb2.Sheets(ws1.Name)
For Each Cell In ws1.UsedRange
If Cell.Formula <> ws2.Range(Cell.Address).Formula Then
Cell.Interior.ColorIndex = 35
ws2.Range(Cell.Address). _
Interior.ColorIndex = 35
End If
Next Cell
If ws1.UsedRange.Rows.Count <> _
ws2.UsedRange.Rows.Count Or _
ws1.UsedRange.Columns.Count <> _
ws2.UsedRange.Columns.Count Then
For Each Cell In ws2.UsedRange
If Cell.Formula <> ws1.Range(Cell.Address).Formula Then
Cell.Interior.ColorIndex = 35
ws1.Range(Cell.Address). _
Interior.ColorIndex = 35
End If
Next Cell
End If
End If
Next ws1
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Sub Clear_Highlights_this_Sheet()
ActiveSheet.UsedRange. _
Interior.ColorIndex = xlNone
End Sub

Sub Clear_Highlights_All_Sheets()
Dim sht As Worksheet
For Each sht In Sheets
sht.UsedRange.Interior.ColorIndex = xlNone
End Sub