CODEWITHSUNDEEP
excelvba
Julian
Julian

Reputation: 25

VBA comparing cells

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

Upvotes: 0

Views: 67

Answers (1)

CDP1802
CDP1802

Reputation: 16392

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

Upvotes: 2

Related Questions