VBA comparing cells - excel

Question

I wrote a little code to mark the differences in two different tables.
When I run the code, there are many right "hits", but for some reason, sometimes the exact same value is marked as different. This mostly happened with numbers or if the alignment is not the same.
To get rid of the alignment- and formatting- problem I wrote/found the following Code:
Sub makeBeautiful()
Dim n As Integer
Dim m As Integer
Dim wks As Worksheet
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("bank-accountsNew")
Dim sht2 As Worksheet
Set sht2 = ThisWorkbook.Worksheets("bank-accountsOld")
n = sht.UsedRange.Rows.Count
m = sht.UsedRange.Columns.Count
For j = 1 To m
For i = 1 To n
If sht.Cells(i, j).Value = "null" Then
sht.Cells(i, j).Value = " "
End If
Next i
Next j
For Each wks In Worksheets
wks.Cells.VerticalAlignment = xlTop
wks.Cells.HorizontalAlignment = xlLeft
Next wks
sht.Cells.NumberFormat = "General"
sht2.Cells.NumberFormat = "General"
End Sub
As far as I can tell, this works just fine.
To mark the differences, I have the following Code:
Sub changeFinder()
Dim n As Integer
Dim m As Integer
Dim p As Integer
Dim o As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim Result As String
Dim item1 As String
Dim item2 As String
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("bank-accountsNew")
Dim sht2 As Worksheet
Set sht2 = ThisWorkbook.Worksheets("bank-accountsOld")
n = sht.UsedRange.Rows.Count
m = sht.UsedRange.Columns.Count
k = sht2.UsedRange.Rows.Count
l = sht2.UsedRange.Rows.Count
For j = 1 To m
sht.Columns(j + 1).Insert
sht.Columns(j + 1).Insert
For i = 2 To n
sht.Cells(i, j + 1).Value = Application.VLookup(sht.Cells(i, 1), sht2.Columns(1).Resize(, j), j, False)
Next i
For i = 2 To n
item1 = sht.Cells(i, j).Text
item2 = sht.Cells(i, j + 1).Text
Result = StrComp(item1, item2)
sht.Cells(i, j + 2) = Result
Next i
For i = 2 To n
If sht.Cells(i, j + 2) = 1 Then
sht.Cells(i, j).Interior.Color = vbRed
End If
Next i
sht.Columns(j + 1).Delete
sht.Columns(j + 1).Delete
Next j
End Sub
My idea was to create two new column next to every column I want to compare. Fill these two new column with the fitting value and a number to check either these values are the same or not. If not, the original value should be marked in red.
I have in both table almost the same bank accounts numbers as column 3.
Some of them are marked as different and some them are not marked as different, but in only case they are not the same. So, my code does not work properly.
As far as I can tell, every value is equally aligned and equally formatted, so I don´t know what could cause Excel to think that the same numbers are different. :/
Table B is created by a json.file. Table A ist created by PowerQuery with two tables, which I have from a json.file.
I hope someone can help me here a litle bit.
Sincerely,
Julian

Answer 1

Rather than repeated VLookups consider using a Dictionary Object.
Option Explicit
Sub changeFinder()
Dim sht1 As Worksheet, sht2 As Worksheet
Dim lastrow As Long, r As Long, r2 As Long
Dim lastcol As Long, c As Long
With ThisWorkbook
Set sht1 = .Sheets("bank-accountsNew")
Set sht2 = .Sheets("bank-accountsOld")
End With
' build look up to sheet2
Dim dict As Object, id As String, n As Long
Set dict = CreateObject("Scripting.Dictionary")
With sht2
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
' scan down sheet
For r = 2 To lastrow
id = Trim(.Cells(r, 1))
If dict.exists(id) Then
MsgBox "Error - duplicate id " & id, vbCritical, sht2.Name & " row " & r
Exit Sub
ElseIf Len(id) > 0 Then
dict.Add id, r
End If
Next
End With
' compare with sheet 1
With sht1
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
With .UsedRange
lastcol = .Columns.Count
.Interior.Color = xlNone 'clear sheet
End With
' scan down sheet
For r = 2 To lastrow
id = Trim(.Cells(r, 1))
' check exists on sheet2
If Not dict.exists(id) Then
.Rows(r).Interior.Color = RGB(128, 255, 128)
n = n + 1
Else
r2 = dict(id) ' sheet 2 row
' scan across columns
For c = 2 To lastcol
If Trim(.Cells(r, c)) <> Trim(sht2.Cells(r2, c)) Then
.Cells(r, c).Interior.Color = RGB(255, 128, 0)
n = n + 1
'Debug.Print .Cells(r, c), sht2.Cells(r2, c)
End If
Next
End If
Next
End With
' result
If n > 0 Then
MsgBox n & " differences found", vbExclamation
Else
MsgBox "No differences found", vbInformation
End If
End Sub