Excel VBA Address comparing output non matching addresses - vba

Question

I am working on a workbook that has three tabs. My Customer list Addresses, Outsource customer listing addresses: and Output No Match:. I am looking to run my list agents an outsource list and if my address list does not match any addresses on the out source list. It outputs on the No match tab.
I have built a working document but it is so slow and feel someone here could really help point me in the right direction.
All three sheets column headers ("Customer Name","Address 1","Address 2","City","State","Zip Code")
I am using a code similar to the one below to find none matches on all the columns. It only looks at the first few characters in hope to speed things up but i am getting no where fast.
I am running it on a loop somewhat like this which seems to be very incessant and slow when comparing addresses agent 200,000 records.
For I = 2 To LastRow
If Left(UCase(Trim(wsAddressS_1.Cells(1 + I, 6).Value)), 5) =
Left(UCase(VLookLike(wsAddressS_1.Cells(1 + I, 6).Value, wsAddressS_2.Range("F1:F" & LastRow2 + 10))), 5) Then
Match_Zip = "Match"
Else
Match_Zip = "No Match"
End If
If strMatchZip <> "Match" Then
LastRow1 = wsAddressS_4.Range("F" & Rows.Count).End(xlUp).Row
wsAddressS_4.Cells(LastRow4 + 1, 1).Value = wsAddressS_1.Cells(1 + I, 1).Value
wsAddressS_4.Cells(LastRow4 + 1, 2).Value = wsAddressS_1.Cells(1 + I, 2).Value
wsAddressS_4.Cells(LastRow4 + 1, 3).Value = wsAddressS_1.Cells(1 + I, 3).Value
wsAddressS_4.Cells(LastRow4 + 1, 4).Value = wsAddressS_1.Cells(1 + I, 4).Value
wsAddressS_4.Cells(LastRow4 + 1, 5).Value = wsAddressS_1.Cells(1 + I, 5).Value
wsAddressS_4.Cells(LastRow4 + 1, 6).Value = wsAddressS_1.Cells(1 + I, 6).Value
End If
Sleep 10
DoEvents
Next I
e.g VLookLike
Private Function VLookLike(txt As String, rng As Range) As String
Dim temp As String, e, n As Long, a()
Static RegX As Object
If RegX Is Nothing Then
Set RegX = CreateObject("VBScript.RegExp")
With RegX
.Global = True
.IgnoreCase = True
.Pattern = "(\S+).*" & Chr(2) & ".*\1"
End With
End If
With RegX
For Each e In rng.Value
If UCase$(e) = UCase(txt) Then
VLookLike = e
Exit For
End If
temp = Join$(Array(e, txt), Chr(2))
If .test(temp) Then
n = n + 1
ReDim Preserve a(1 To 2, 1 To n)
a(2, n) = e
Do While .test(temp)
a(1, n) = a(1, n) + Len(.Execute(temp)(0).submatches(0))
temp = Replace(temp, .Execute(temp)(0).submatches(0), "")
Loop
End If
Next
End With
If (VLookLike = "") * (n > 0) Then
With Application
VLookLike = .HLookup(.Max(.Index(a, 1, 0)), a, 2, False)
End With
End If
End Function
Any help or suggestions would be much appreciated!

Answer 1

I haven't read all the code, sorry, but I have had problems on comparing strings. Perhaps it would work if you tell vba that you are gonna compare 2 strings. You could use the function Cstr() for example
CStr(Left(UCase(StrAddress), 3)) = CStr(Left(UCase(VLookLike(StrAddress, rng2)), 3))