Macro to compare two excel sheets
Solved/Closed
Related:
- Compare two worksheets and paste differences to another sheet - excel vba free download
- Compare two excel sheets and highlight differences macro - Best answers
- Vba compare two worksheets - Best answers
- Kmspico free download - Download - Other
- Fc 24 free download - Download - Sports
- Gta 5 download apk pc - Download - Action and adventure
- Minecraft bedrock free download pc - Download - Sandbox
- Minecraft java edition free download - Download - Sandbox
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
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
Worksheets("sheet3").Cells.Clear
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
line1:
Next c
Application.CutCopyMode = False
End With 'sheet 1
End Sub
Dec 7, 2011 at 09:42 PM
Dec 8, 2011 at 12:02 PM
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
Aug 2, 2012 at 04:58 AM
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
Next
'
On Error Resume Next
ReDo1:
Application.DisplayAlerts = False
sBook = Application.InputBox(Prompt:= _
"Compare this workbook (" & wb1.Name & _
") to...?", _
Title:="Compare to what workbook?", _
Default:=wb2.Name, _
Type:=2)
If sBook = "False" Then Exit Sub
If Workbooks(sBook) Is Nothing Then
MsgBox "Workbook: " & sBook & " is not open."
GoTo ReDo1
Else
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
Next
End Sub