Comparing rows and reporting back diferences Excel VBA - excel

Question

I've been trying to use the following code to compare two Excel sheets however I can't get it to function quite as I need. I need to compare row by row and report specific differences even when rows of data on each sheet are not necessarily in the same order. The code reports all differences based on how the data physically exists in the tables. So it is showing differences but if the data was put into the same order in each table they wouldn't actually be differences. Due to the nature of the data I can't sort first. Hope this makes sense. Could someone please suggest what changes are required to get what I need?
Sub Compare()
' compare two different worksheets in the active workbook
CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")
' compare two different worksheets in two different workbooks
'CompareWorksheets ActiveWorkbook.Worksheets("Sheet1"), _
' Workbooks("impchk1.xls").Worksheets("Sheet2")
End Sub
Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
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 rptWB As Workbook, DiffCount As Long
Application.ScreenUpdating = False
Application.StatusBar = "Creating the report..."
Set rptWB = Workbooks.Add
Application.DisplayAlerts = False
While Worksheets.Count > 1
Worksheets(2).Delete
Wend
Application.DisplayAlerts = True
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
Application.StatusBar = "Comparing cells " & Format(c / maxC, "0 %") & "..."
For r = 1 To maxR
cf1 = ""
cf2 = ""
On Error Resume Next
cf1 = ws1.Cells(r, c).FormulaLocal
cf2 = ws2.Cells(r, c).FormulaLocal
On Error GoTo 0
If cf1 <> cf2 Then
DiffCount = DiffCount + 1
Cells(r, c).Formula = "'" & cf1 & " <> " & cf2
End If
Next r
Next c
Application.StatusBar = "Formatting the report..."
With Range(Cells(1, 1), Cells(maxR, maxC))
.Interior.ColorIndex = 19
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
On Error Resume Next
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
On Error GoTo 0
End With
Columns("A:IV").ColumnWidth = 20
rptWB.Saved = True
If DiffCount = 0 Then
rptWB.Close False
End If
Set rptWB = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox DiffCount & " cells contain different formulas!", vbInformation, _
"Compare " & ws1.Name & " with " & ws2.Name
End Sub

Answer 1

In the worksheet that will be updated, convert each row to a string and save it to a dictionary. Then, in the worksheet you're updating from, loop through all the rows, get their string rep and see if it exists in the dictionary. If it doesn't, then add them.
Here's an example code that gets a string from a rows values
Sub getRowAsString()
Dim cell As Object
Dim sheet As Worksheet
Dim str As String
Dim arr() As Variant
Dim arr2() As Variant
Dim printCol As Integer
Set sheet = ActiveSheet
printCol = sheet.UsedRange.Columns.Count + 1
For Each cell In sheet.UsedRange.Rows
arr = cell.Value2
ReDim arr2(LBound(arr, 2) To UBound(arr, 2))
For i = LBound(arr, 2) To UBound(arr, 2)
arr2(i) = arr(1, i)
Next i
str = Join(arr2, ", ")
ActiveSheet.Cells(cell.Row, printCol).value = str
Next cell
End Sub
Here's an example of using a dictionary:
Sub createDictionary()
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Key = "hello"
value = "world"
dict.Add Key, value
MsgBox "key exists: " & dict.exists(Key) & vbNewLine & "value: " & dict(Key)
End Sub
If the string representation of a row is too large, you can save a hashed value of it into the dictionary to make it more manageable. Here is a post that gives VBA code for hashing a string