How to apply Application.Match with values > 255 characters?

Question

I loop through two sheets (OLD, NEW) to determine which values are non-existing in the other.
The values are not always in the same sequence, therefore I can't check row by row. I search to see if a value exists.

The following takes a long time to run. (01:50 min with my test ranges.)

Sub LOOPING()
'-------------------------------------------------------------------
Dim StartTime As Double
StartTime = Timer
'-------------------------------------------------------------------
Dim rngNEW As Range
Set rngNEW = Sheets("NEW").Range("D1:D6734")
Dim rngOLD As Range
Set rngOLD = Sheets("OLD").Range("D1:D6734")

a = ""
For Each item In rngNEW
    For Each item2 In rngOLD
        If item = item2 Then
            GoTo NextIter
        End If
    Next item2
    a = a & "," & item.Row
NextIter:
Next item

MsgBox a
'-------------------------------------------------------------------
MsgBox "RunTime : " & Format((Timer - StartTime) / 86400, "hh:mm:ss")
'-------------------------------------------------------------------
End Sub

The following runs fast but does not return anything (00:02 min with the same test ranges.)
I found the match function does not work with cell values greater than 255 characters. Some of the cell values exceed 3000 characters.

Sub MATCHING()
'-------------------------------------------------------------------
Dim StartTime As Double
StartTime = Timer
'-------------------------------------------------------------------
Dim rngNEW As Range
Set rngNEW = Sheets("NEW").Range("D1:D6734")
Dim rngOLD As Range
Set rngOLD = Sheets("OLD").Range("D1:D6734")

a = ""
For Each item In rngNEW
    If IsError(Application.Match(item, rngOLD, 0)) Then
        a = a & "," & item.Row
    End If
Next item
MsgBox a
'-------------------------------------------------------------------
MsgBox "RunTime : " & Format((Timer - StartTime) / 86400, "hh:mm:ss")
'-------------------------------------------------------------------
End Sub

Is there a way to overcome the 255 character limit?

Did you try to fully qualify range references? Btw Could be helpful to avoid blank items, too. — T.M., Mar 12 '21 at 09:10
The ranges are exact and there are no blank items in the range — MK01111000, Mar 12 '21 at 09:16
No, there may be more, less or different values in both NEW and OLD — MK01111000, Mar 12 '21 at 10:19
Your code works for me as expected. What does "does not return anything" mean? `MsgBox a` is empty because `a` is `""`? What kind of data is in `D1:D6734`? Please show an excerpt. — Axel Richter, Mar 12 '21 at 10:36
Do you want to find OLD values not in NEW also ? Are all the rows unique i.e no duplicates within the sheet. — CDP1802, Mar 12 '21 at 16:03
Finding OLD values not in NEW would be even better still, but I can do without. As for duplicates on the same sheet, there are none. — MK01111000, Mar 13 '21 at 07:38

CDP1802 · Accepted Answer · 2021-03-13T08:38:46.720

If you have the necessary dotNet components then this might work for you. It essentially hashes the text into a 40 byte string using SHA1 and stores that as a dictionary key for the comparison between New and Old. See here for SHA1 subroutine.

Option Explicit

Sub LOOPING()
    '-------------------------------------------------------------------
    Dim StartTime As Double
    StartTime = Timer
    '-------------------------------------------------------------------
    
    Const COL = "D"
    Const LASTROW = 6734
    Dim wsNEW As Worksheet, wsOLD As Worksheet, wsDebug As Worksheet
    Dim i As Long, n As Long
    Dim key As String, msg As String, s As String
    Dim dictOLD As Object, dictNEW As Object

    With ThisWorkbook
       Set wsNEW = .Sheets("NEW")
       Set wsOLD = .Sheets("OLD")
       Set wsDebug = .Sheets("DEBUG")
    End With
    wsDebug.Cells.Clear
    wsDebug.Range("A1:D1") = Array("NEW Row", "NEW Value", "OLD Row", "OLD Value")
    n = 2

    ' build dictionary with SHA1 digests as keys
    Set dictOLD = CreateObject("Scripting.Dictionary")
    For i = 1 To LASTROW
        key = Trim(wsOLD.Cells(i, COL))
        If Len(key) > 0 Then
            key = SHA1(key)
            dictOLD(key) = i
        End If
    Next

    ' scan NEW for items not in OLD
    msg = "NEW not in OLD:"
    Set dictNEW = CreateObject("Scripting.Dictionary")
    For i = 1 To LASTROW
        s = Trim(wsNEW.Cells(i, COL))
        If Len(s) > 0 Then
            key = SHA1(s)
            If Not dictOLD.exists(key) Then
                msg = msg & "," & i
                wsDebug.Cells(n, 1) = i
                wsDebug.Cells(n, 2) = s
                wsDebug.Cells(n, 3) = "No match"
                n = n + 1
            End If
            dictNEW(key) = i
        End If
    Next

   ' scan OLD for items not is NEW
    msg = msg & vbCr & "OLD not in NEW:"
    For i = 1 To LASTROW
        s = Trim(wsOLD.Cells(i, COL))
        If Len(s) > 0 Then
            key = SHA1(s)
            If Not dictNEW.exists(key) Then
                msg = msg & "," & i
                wsDebug.Cells(n, 1) = "No Match"
                wsDebug.Cells(n, 3) = i
                wsDebug.Cells(n, 4) = s
                n = n + 1
            End If
        End If
    Next

    MsgBox msg, vbInformation, "No Match"
    '-------------------------------------------------------------------
    MsgBox "RunTime : " & Format((Timer - StartTime) / 86400, "hh:mm:ss")
    '-------------------------------------------------------------------
End Sub

Public Function SHA1(ByVal s As String) As String
    Dim Enc As Object, Prov As Object
    Dim Hash() As Byte, i As Integer

    Set Enc = CreateObject("System.Text.UTF8Encoding")
    Set Prov = CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider")

    Hash = Prov.ComputeHash_2(Enc.GetBytes_4(s))

    SHA1 = ""
    For i = LBound(Hash) To UBound(Hash)
        SHA1 = SHA1 & Hex(Hash(i) \ 16) & Hex(Hash(i) Mod 16)
    Next
End Function

stifin · Answer 2 · 2021-03-12T11:00:51.330

-1

You test If IsError...

When there's no error, it just skips to the next iteration. This is why you are not getting anything. So you can change it to If Not IsError(Application.Match(item, rngOLD,0)) Then.

Also, you are timing this but you repeatedly concatenate to string a -- this is a well-known performance-killer (I quickly found this article for an explanation) -- you improve on this by, for example, allocating each bit to a large array and then joining them all after you finish the loop

edited Mar 12 '21 at 11:00

answered Mar 12 '21 at 10:00

stifin

1,390
3
18
28

Removing IsError returns an error `Run-time error 13, Type Mismatch` – MK01111000 Mar 12 '21 at 10:18
2

`Application.Match` **returns** an error value, in opposite to `WorksheetFunction.Match` which **throws** error. So using `IsError` is correct using `Application.Match`. – Axel Richter Mar 12 '21 at 10:31
the logic is that `a` is to be updated if there is a match, when there is no error -- I'll modify my answer – stifin Mar 12 '21 at 10:56
@stifin Currently my code loops through rngNEW. for each value in rngNEW it checks is a similar value exists in rngOLD by means of `application.Match`. If it does not find a similar value in rngOLD it should give the row-number of the current line it is testing in rngNEW. The problem I am having is that it does not give me row numbers even if the exact same value does not exist in rngOLD. – MK01111000 Mar 12 '21 at 13:55
Changing it into `If Not IsError(Application.Match(item, rngOLD,0)) Then` only gives me all the row numbers of values from rngNEW for which a similar value exists in rngOLD. (but also in this case it returns all row numbers eventhough the value is different) – MK01111000 Mar 12 '21 at 13:57
1

I think I know what the problem is. Most of the cell values have more than 255 characters. – MK01111000 Mar 12 '21 at 14:09

How to apply Application.Match with values > 255 characters?

2 Answers2