How to compare two rows of data accounting for wildcard? - arrays

Question

I want to compare two set of rows, data from sheet "Calculated Structure" is compared against data from sheet "MAP" and if it is a match return the value in last column.
Based on other responses I have the following code which joins the rows into a string and then leverages dictionary to perform the compare. I am using dictionary to improve performance as I am comparing MAP and DATA that are both 50,000+ records.
Sub CheckRows()
Dim cl As Range
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Vlu As String
Dim VluD As String
Dim Lc As Long
Dim x As Long
Dim i As Long
Dim ArrRslt() As Variant
Dim iRw As Long
Dim LastRow As Long
Dim RngTrgt As Range
Dim dict As New Scripting.Dictionary
Set Ws1 = Sheets("Calculated Structure")
Set Ws2 = Sheets("Map")
Lc = Ws2.Cells(2, Columns.Count).End(xlToLeft).Column - 1
RsltCol = Ws1.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
For icntr = RsltCol To 1 Step -1
If Cells(1, icntr).value = "Calced Result" Then
Columns(icntr).Delete
End If
Next
LastCol = Ws1.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Cells(1, LastCol + 1).value = "Calced Result"
i = 1
x = 1
ReDim ArrRslt(0)
With CreateObject("scripting.dictionary")
dict.CompareMode = 1
For Each cl In Ws2.Range("A1", Ws2.Range("A" & Rows.Count).End(xlUp))
Vlu = Join(Application.Index(cl.RESIZE(, Lc).value, 1, 0), "|")
dict.Add key:=Vlu, Item:=(Ws2.Cells(i, Lc + 1))
i = i + 1
Next cl
For Each cl In Ws1.Range("B2", Ws1.Range("B" & Rows.Count).End(xlUp))
VluD = Join(Application.Index(cl.RESIZE(, Lc).value, 1, 0), "|")
If dict.Exists(VluD) Then
CResult = dict(VluD)
ArrRslt(x - 1) = CResult
Else
ArrRslt(x - 1) = "?"
End If
ReDim Preserve ArrRslt(0 To x)
x = x + 1
Next cl
End With
LastRow = Ws1.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set RngTrgt = Ws1.Range(Cells(2, Lc + 2), Cells(LastRow, Lc + 2))
RngTrgt = Application.WorksheetFunction.Transpose(ArrRslt)
MsgBox "Mapping Complete!"
End Sub
Some instances row on "MAP" have wildcard("*") designated as the cell value.
For example MAP looks like:
Check 1
Check 2
Check 3
Result
ABC
DEF
123
R1
ABC
*
123
R2
And my data looks like:
Field 1
Field 2
Field 3
Expected Result
ABC
DEF
123
R1
ABC
GHI
123
R2
For my second row of data I expect to return "R2" because in the MAP check 2 is wildcarded, so any value for Field 2 should pass. Instead the "?" is returned indicating no match found. My understanding is that this is because string "ABC|GHI|123" is not defined in the map.
What can I do to account for the wildcard values?
I feel I need to evaluate each "Check/Field" individually. Meaning first see if match found for Check 1, if so search for match for Check 2, so on till all matches are found.

Answer 1

I tried nested dictionaries. I believe that I am able to assign values appropriate but hitting a Run-time Error '450' when trying to retrieve information from the dictionaries. Here is my code:
Sub theDictionary()
Dim cl As Range
Dim WsRslt As Worksheet
Dim WsMap As Worksheet
Dim Vlu As String
Dim VluD As String
Dim Lc As Long
Dim MapVl As Long
Dim RsltCol As Long
Dim icntr As Long
Dim LastCol As Long
Dim rCount As Long
Dim mCount As Long
Dim x As Long
Dim i As Long
Dim dictCount As Long
Dim ArrRslt() As Variant
Dim iRw As Long
Dim LastRow As Long
Dim previousCell As String
Dim cResult As String
Dim RngTrgt As Range
Dim dict As New Scripting.Dictionary
Dim subDict() As Object
Set WsRslt = Sheets("Calculated Structure")
Set WsMap = Sheets("Map")
MapVl = WsMap.Cells(2, Columns.Count).End(xlToLeft).Column
Lc = MapVl - 1
MsgBox "Map value=" & MapVl & "and LC=" & Lc
RsltCol = WsRslt.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
For icntr = RsltCol To 1 Step -1
If Cells(1, icntr).value = "Calced Result" Then
Columns(icntr).Delete
End If
Next
LastCol = WsRslt.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Cells(1, LastCol + 1).value = "Calced Result"
i = 1
x = 1
dictCount = 1
rCount = 1
ReDim ArrRslt(0)
previousCell = ""
ReDim subDict(1 To MapVl - 1)
For dictCount = 1 To MapVl - 1
Set subDict(dictCount) = New Scripting.Dictionary
subDict(dictCount).CompareMode = vbTextCompare
Next dictCount
For Each cl In WsMap.Range("A2", WsMap.Range("A" & Rows.Count).End(xlUp))
For rCount = 1 To MapVl - 1
'get the first item and add it to the subdictionary
' MsgBox "MapVl=" & MapVl & " and rCount=" & rCount
If rCount = 1 Then
If subDict(rCount).Exists(cl.Offset(0, MapVl - (rCount + 1)).Value2) Then
' MsgBox cl.Offset(0, MapVl - (rCount + 1)) & " Exists"
Else
' MsgBox cl.Offset(0, MapVl - (rCount + 1)) & " First Add"
subDict(rCount).Add CStr(cl.Offset(0, MapVl - (rCount + 1)).Value2), CStr(cl.Offset(0, MapVl - rCount).Value2)
End If
ElseIf rCount < MapVl Then
subDict(rCount).Add CStr(cl.Offset(0, MapVl - (rCount + 1)).Value2), subDict(rCount - 1)
End If
' MsgBox "Prev Cell Blank=" & previousCell & "cl.value=" & cl.value
Next rCount
rCount = 1
Next cl
For Each cl In WsRslt.Range("B2", WsRslt.Range("B" & Rows.Count).End(xlUp))
For mCount = 1 To MapVl - 1
VluD = cl.Value2 'Join(Application.Index(cl.RESIZE(, Lc).value, 1, 0), "|")
MsgBox "Cell Value=" & VluD
If subDict(MapVl - mCount).Exists(VluD) Then
MsgBox "VluD= " & VluD
cResult = subDict(MapVl - mCount).Item(VluD) '<-- Run-time error '450': Wrong number of arguments or invalid property assignment
ArrRslt(x - 1) = cResult
MsgBox "cResult=" & cResult
Else
ArrRslt(x - 1) = "?"
End If
ReDim Preserve ArrRslt(0 To x)
x = x + 1
Next mCount
Next cl
LastRow = WsRslt.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set RngTrgt = WsRslt.Range(Cells(2, Lc + 2), Cells(LastRow, Lc + 2))
RngTrgt = Application.WorksheetFunction.Transpose(ArrRslt)
MsgBox "Mapping Complete!"
End Sub
Once I am able to read the values, I still need to figure out how I am going to account for the "wildcard" values in MAP.
Any guidance is greatly appreciated.