Macro - Compare two sheet with rows in different order using one column as ID

[sgs2015]

Hello

I'm trying to create a macro to compare two sheets (I need to compare five but two for now is enough) and highlight the differences. The problem is that in my sheets the rows are not always in the same order and not all sheets have exactly the same number of rows so I can't use a simple a macro as the following to compare row by row because when it arrives to a row that is on a different order, it will highlight that row and the following as if they where different when is just in a different order

Sub RunCompare()


Call compareSheets("Sheet1", "Sheet2")


End Sub




Sub compareSheets(shtSheet1 As String, shtSheet2 As String)


Dim mycell As Range
Dim mydiffs As Integer


'For each cell in sheet2 that is not the same in Sheet1, color it yellow
For Each mycell In ActiveWorkbook.Worksheets(shtSheet2).UsedRange
    If Not mycell.Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value Then
        
        mycell.Interior.Color = vbYellow
        mydiffs = mydiffs + 1
        
    End If
Next


'Display a message box to demonstrate the differences
MsgBox mydiffs & " differences found", vbInformation


ActiveWorkbook.Sheets(shtSheet2).Select


End Sub

The data on my sheet is nothing especial, just between 1000 and 3000 rows all of them text with the same number of columns and being the first column a unique string used as ID.

I'll need something more advance that use the ID on sheet 1 to then look for that same ID on sheet 2 and finally compare those two rows. I've never programmed excel macros before and even tough I can think the logic I have no idea how to code it.

 

[sgs2015]

I've been trying to do the coding and I arrive to following point. Is almost done except the part of the first if where I'm stuck trying to compare the values of the Colum A on each sheet.

Sub RunCompare()


Call compareSheets("Sheet1", "Sheet2")


End Sub




Sub compareSheets(shtSheet1 As String, shtSheet2 As String, shtSheet3 As String)


Dim mycell1 As Range
Dim mycell2 As Range
Dim mydiffs As Integer
Dim noexist As Integer
Dim match As Boolean 


'For each cell in sheet2 that is not the same in Sheet1, color it yellow
For Each mycell2 In ActiveWorkbook.Worksheets(shtSheet2).UsedRange
	For each mycell1 in ActiveWorkbook.Worksheets(shtSheet1).UsedRange
		If mycell2.ColumnAvalue = ActiveWorkbook.Worksheets(shtSheet1).mycell1.ColumAvalue Then
		
			If Not mycell2.Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell2.Row, mycell2.Column).Value Then
        
				mycell2.Interior.Color = vbYellow
				mydiffs = mydiffs + 1
			    match = true    
			End If
		End If
	Next
	If match = false Then
			mycell2.Interior.Color = vbRed
			noexist = noexist + 1
Next


'Display a message box to demonstrate the differences
MsgBox mydiffs & " differences found, " & noexist & "New rows", vbInformation


ActiveWorkbook.Sheets(shtSheet2).Select


End Sub

 

[sgs2015]

I managed to create the macro I was looking for and here is the code in case somebody needs something similar. It also have a function to clear all the highlighted cells in one sheet or all sheets. Now I'll work in that code to make the same in more then two sheets.

Sub RunCompare()




Call compareSheets("Sheet1", "Sheet2")




End Sub








Sub compareSheets(shtSheet1 As String, shtSheet2 As String)




Dim c As Integer, j As Integer, i As Integer, mydiffs As Integer, cnt1 As Integer, cnt2 As Integer
Dim noexist As Integer


cnt2 = Worksheets("Sheet2").Cells.SpecialCells(xlCellTypeLastCell).Row
cnt1 = Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
'For each cell in sheet2 that is not the same in Sheet1, color it yellow


For i = 1 To cnt2
    For j = 1 To cnt1
        If ActiveWorkbook.Worksheets(shtSheet2).Cells(i, 1).Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(j, 1).Value Then
            For c = 2 To 22
                If Not ActiveWorkbook.Worksheets(shtSheet2).Cells(i, c).Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(j, c).Value Then
                    ActiveWorkbook.Worksheets(shtSheet2).Cells(i, c).Interior.Color = vbYellow
                    mydiffs = mydiffs + 1
                End If
            Next
        Exit For
        End If
        If j = cnt1 Then
            ActiveWorkbook.Worksheets(shtSheet2).Cells(i, 1).Interior.Color = vbRed
        End If
    Next
Next




'Display a message box to demonstrate the differences and if there is a new entry on the second sheet
MsgBox mydiffs & ":differences found, " & noexist & ":no exist", vbInformation


ActiveWorkbook.Sheets(shtSheet2).Select




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

 

[urhen22]

sgs2015
Thank you! This is exactly what I was looking for (I was googling for the following: excel macro "find new rows", excel macro "find inserted rows", excel macro find added rows, excel macro detect added rows etc.). Your macro works great, just to inform if somebody else new to macros tries your solution, they should run the "RunCompare" part of your macro and set a shortcut to it.

By the way, do you know how to detect added columns in the same way? So that it would mark the added column as red and then detect changed values for the cells on the right side of the added column (now it marks all columns and cells as yellow on the right side of the added column, of course, because they have changed)?