VBA- Not recognizing new values in columns when searching for duplicates - vba

Question

I am running VBA to search for differences in values in rows between column D and column G. My code works for the first try, but when I add more values towards the end (that are not the same values), the code doesn't seem to follow.
Option Explicit
Public Sub RateTest1()
Const COLUMN_1 = "D", WS1_START = 2
Const COLUMN_2 = "G", WS2_START = 2
Dim ws1 As Worksheet, ws2 As Worksheet, col1 As Variant, col2 As Variant, tr As Long
Dim max1 As Long, max2 As Long, r1 As Long, r2 As Long, red As Long, found As Boolean
Dim miss As Range
tr = Rows.Count: red = RGB(255, 0, 0)
Set ws1 = ThisWorkbook.Sheets("Sheet1"): max1 = ws1.Cells(tr, COLUMN_1).End(xlUp).Row
Set ws2 = ThisWorkbook.Sheets("Sheet1"): max2 = ws2.Cells(tr, COLUMN_2).End(xlUp).Row
col1 = ws1.Range(ws1.Cells(1, COLUMN_1), ws1.Cells(max1, COLUMN_1))
col2 = ws2.Range(ws2.Cells(1, COLUMN_2), ws2.Cells(max2, COLUMN_2))
For r2 = WS2_START To max2
For r1 = WS1_START To max1
If Len(col1(r1, 1)) > 0 And col1(r1, 1) <> "N/A" Then
found = (col1(r1, 1) = col2(r2, 1))
If found Then Exit For
End If
Next
If Not found Then
If miss Is Nothing Then
Set miss = ws2.Cells(r2, COLUMN_2)
Else
Set miss = Union(miss, ws2.Cells(r2, COLUMN_2))
End If
End If
Next
miss.Interior.Color = red
For r2 = WS2_START To max2
For r1 = WS1_START To max1
If Len(col2(r2, 1)) > 0 And col1(r2, 1) <> "N/A" Then
found = (col1(r2, 1) = col2(r1, 1))
If found Then Exit For
End If
Next
If Not found Then
If miss Is Nothing Then
Set miss = ws2.Cells(r2, COLUMN_2)
Else
Set miss = Union(miss, ws2.Cells(r2, COLUMN_2))
End If
End If
Next
miss.Interior.Color = red
End Sub
The codes sometimes only recognizes that column D and G are different if the value in D is greater than G and hardly ever the other way around. The "N/A" code is there because eventually I want to add code that does not highlight if column D has a 1 and column G has an "N/A". Those are considered the same values.

Answer 1

The 2 procedures will find differences (non-empty values) between the two columns, with the exception of value "1" in column D, and value "N/A" in column G
Option Explicit
Public Sub RateTest()
Dim ws As Worksheet, miss As Range, tmp As Range, t As Double
Dim max1 As Long, max2 As Long, colD As Range, colG As Range
t = Timer
Set ws = ThisWorkbook.Sheets("Sheet1")
max1 = ws.Cells(Rows.Count, "D").End(xlUp).Row
max2 = ws.Cells(Rows.Count, "G").End(xlUp).Row
Set colD = ws.Range(ws.Cells(2, "D"), ws.Cells(max1, "D"))
Set colG = ws.Range(ws.Cells(2, "G"), ws.Cells(max2, "G"))
colD.Interior.ColorIndex = xlColorIndexNone
colG.Interior.ColorIndex = xlColorIndexNone
Set miss = CheckColumns(colD, colG, "N/A")
If miss Is Nothing Then
Set miss = CheckColumns(colG, colD, "1")
Else
Set tmp = CheckColumns(colG, colD, "1")
If Not tmp Is Nothing Then Set miss = Union(miss, tmp)
End If
If Not miss Is Nothing Then miss.Interior.Color = RGB(255, 0, 0)
Debug.Print "Rows: " & max1 & "; Time: " & Format(Timer - t, "0.000") & " sec"
End Sub
Private Function CheckColumns(col1 As Range, col2 As Range, x As String) As Range
Dim c As Variant, r As Long, d As Object, rng As Range
col1.NumberFormat = "#,##0.00###"
c = col1.Value2
Set d = CreateObject("Scripting.dictionary")
For r = 1 To UBound(c)
With col1.Cells(r)
If .Errors.Item(xlNumberAsText).Value Then .Value2 = .Value2 + 0
End With
d(Trim$(CStr(c(r, 1)))) = vbNullString
Next
c = col2.Value2
For r = 1 To UBound(c)
If Len(c(r, 1)) > 0 Then
If c(r, 1) <> x Then
If Not d.exists(Trim(CStr(c(r, 1)))) Then
If rng Is Nothing Then
Set rng = col2.Cells(r)
Else
Set rng = Union(rng, col2.Cells(r))
End If
End If
End If
End If
Next
Set CheckColumns = rng
End Function
Edit to include test results:
Number Format:
MS reference to Cells().Errors