Application.Match not exact value - vba

Question

Have a piece of code that looks for matches between 2 sheets (sheet1 is customer list and rData is copied pdf with invoices). It usually is exact match but in some cases I'm looking for 6 first characters that matches rData
Dim rData As Variant
Dim r As Variant
Dim r20 As Variant
Dim result As Variant
Dim i As Long
rData = ActiveWorkbook.Sheets(2).Range("A1:A60000")
r20 = ActiveWorkbook.Sheets(1).Range("C2:C33")
For Each r In r20
result = Application.Match(r, rData, 0)
If Not IsError(result) Then
For i = 1 To 5
If (result - i) > 0 Then
If (Left(Trim(rData(result - i, 1)), 3) = "418") Then
MsgBox "customer: " & r & ". invoice: " & rData(result - i, 1)
End If
End If
Next
For i = 1 To 15
If (result + i) > 0 Then
If (Left(Trim(rData(result + i, 1)), 3) = "418") Then
MsgBox "customer: " & r & ". invoice: " & rData(result + i, 1)
End If
End If
Next
End If
Next r
End Sub
Only part of this that is giving me a headache is this part result = Application.Match(r, rData, 0). How do it get match for not exact match?
Sample of Sheet1
This is what more or less looks like. Matching after CustomerNumber# is easy because they are the same every invoice. BUT sometimes invoice does not have it so I'm searching after CustomerName and sometimes they have uppercase letters, sometimes there is extra stuff behind it and therefore it cannot find exact match.
Hope it makes sense.

Answer 1

To match the customer name from your customer list to the customer name in the invoice even if it has extra characters appended, you can use the wildcard * in Match().
You also have a typo in the Match() function. r20 should be rData.
This is your code with the fixes applied:
Sub Test()
'v4
Dim rData As Variant
Dim r As Variant
Dim r20 As Variant
Dim result As Variant
Dim i As Long
rData = ActiveWorkbook.Sheets(2).Range("A1:A60000")
r20 = ActiveWorkbook.Sheets(1).Range("C2:C33")
For Each r In r20
result = Application.Match(r & "*", rData, 0) ' <~ Fixed here
If Not IsError(result) Then
For i = 1 To 5
If (result - i) > 0 Then
If (Left(Trim(rData(result - i, 1)), 3) = "418") Then
MsgBox "customer: " & r & ". invoice: " & rData(result - i, 1)
End If
End If
Next
For i = 1 To 15
If (result + i) > 0 Then
If (Left(Trim(rData(result + i, 1)), 3) = "418") Then
MsgBox "customer: " & r & ". invoice: " & rData(result + i, 1)
End If
End If
Next
End If
Next r
End Sub
Notes:
Match() is case insensitive, so it works with different capitalisations.
The data in Sheets(2) must all be text for Match() to work correctly with wildcards.
EDIT1: New better version
EDIT2: Refactored constants and made data ranges dynamic
EDIT3: Allows for any prefix to an invoice number of a fixed length
The following is a better, rewritten version of your code:
Sub MuchBetter()
'v3
Const s_InvoiceDataWorksheet As String = "Sheet2"
Const s_InvoiceDataColumn As String = "A:A"
Const s_CustomerWorksheet As String = "Sheet1"
Const s_CustomerStartCell As String = "C2"
Const s_InvoiceNumPrefix As String = "418"
Const n_InvoiceNumLength As Long = 8
Const n_InvScanStartOffset As Long = -5
Const n_InvScanEndOffset As Long = 15
Dim ƒ As Excel.WorksheetFunction: Set ƒ = Excel.WorksheetFunction ' Shortcut
With Worksheets(s_InvoiceDataWorksheet).Range(s_InvoiceDataColumn)
With .Parent.Range(.Cells(1), .Cells(Cells.Rows.Count).End(xlUp))
Dim varInvoiceDataArray As Variant
varInvoiceDataArray = ƒ.Transpose(.Cells.Value2)
End With
End With
With Worksheets(s_CustomerWorksheet).Range(s_CustomerStartCell)
With .Parent.Range(.Cells(1), .EntireColumn.Cells(Cells.Rows.Count).End(xlUp))
Dim varCustomerArray As Variant
varCustomerArray = ƒ.Transpose(.Cells.Value2)
End With
End With
Dim varCustomer As Variant
For Each varCustomer In varCustomerArray
Dim dblCustomerIndex As Double
dblCustomerIndex = Application.Match(varCustomer & "*", varInvoiceDataArray, 0)
If Not IsError(dblCustomerIndex) _
And varCustomer <> vbNullString _
Then
Dim i As Long
For i = ƒ.Max(dblCustomerIndex + n_InvScanStartOffset, 1) _
To ƒ.Min(dblCustomerIndex + n_InvScanEndOffset, UBound(varInvoiceDataArray))
Dim strInvoiceNum As String
strInvoiceNum = Right$(Trim$(varInvoiceDataArray(i)), n_InvoiceNumLength)
If (Left$(strInvoiceNum, Len(s_InvoiceNumPrefix)) = s_InvoiceNumPrefix) Then
MsgBox "customer: " & varCustomer & ". invoice: " & strInvoiceNum
End If
Next
End If
Next varCustomer
End Sub
Notes:
It is a good idea to use constants so all literal values are typed once only and kept grouped together.
Using the RVBA naming convention greatly increases the readability of the code, and reduces the likelihood of bugs.
Using long, appropriately named variables makes the code essentially self-documenting.
Using .Value2 whenever reading cell values is highly recommended (it avoids implicit casting, making it slightly faster as well as eliminating certain issues caused by the casting ).
Surprisingly, in VBA there are good reasons to put a variable declaration as close as possible to the first use of the variable. Two such reasons are 1) it improves readability, and 2) it simplifies future refactoring. Just remember that the variable is not reinitialised every time the Dim is encountered. Initialisation only occurs the first time.
The twin loops have been rolled into one according to the DRY principle.
Whilst the check for an empty customer name/number is not strictly necessary if you can guarantee it will never be so, it is good defensive programming as an empty value will cause erroneous results.
The negative index check inside the loop has been removed and replaced with the one-time use of the Max() worksheet function in the For statement.
The Min() worksheet function is also used in the For statement to avoid trying to read past the end of the array.
Always use worksheet functions on the WorksheetFunction object unless you are explicitly checking for errors, in which case use the Application object.