VBA - Searching and Returning IF Multiple Query has been met

[Razor_Rob]

Hi I've got a VBA code that uses the Dictionary Object
wsAvailabilityCodes - worksheet where it search for certain records
wsDest - destination worksheet where the data gets copied into

wsAvailabilityCodes has multiple columns (table below has limited number of columns)

A	B	C	D	I	....	K	P	Q	R
1234	CPC123456	Product 1	New York				User	Office	G2
5678	UEE123456	Product 2	Los Angeles				User	Office	G2
9112	MEM12345-TEST	Product 3	Denver				Standard	Work	G6

My VBA below looks for the value in Column B then returns the value in Column A, I & K.
Now what I want to add is add multiple query like if value of B and = "User" from P and also = "Office" from Q and also = "G2" from R
then return the Value of A, I and K to wsDest
Thanks in advance

    Dim Col2 As Range
    Dim Dict1 As Object
    ' Dim Dict2 As Object  <-- has been removed (not required)
    Dim Col3 As Range
    Dim Dict3 As Object
    Dim Dict4 As Object
        
    Set Dict1 = CreateObject("scripting.dictionary")
    'Set Dict2 = CreateObject("scripting.dictionary")
    Set Dict3 = CreateObject("scripting.dictionary")
    Set Dict4 = CreateObject("scripting.dictionary")
                
    With wsAvailabilityCodes
        For Each Col2 In .Range("B5", .Range("B" & Rows.Count).End(xlUp))
            Dict1(Col2.Value) = Col2.Value            
            Dict3(Col2.Value) = Col2.Offset(, 7).Value
            Dict4(Col2.Value) = Col2.Offset(, 8).Value
        Next Col2
    End With
    With wsDest
        For Each Col2 In .Range("Y3", .Range("Y" & Rows.Count).End(xlUp))
            If Dict1.exists(Col2.Value) Then Col2.Offset(, 1).Value = Dict1(Col2.Value)            
            If Dict3.exists(Col2.Value) Then Col2.Offset(, 2).Value = Dict3(Col2.Value)
            If Dict4.exists(Col2.Value) Then Col2.Offset(, 4).Value = Dict4(Col2.Value)
        Next Col2
    End With

 

[Alex Blakenburg]

So how do we know which line in Dest matches which line in availability

 

[Razor_Rob]

IF wsDest Column Y matches with wsAvailbilityCodes column B AND
IF wsA...Codes Column P = "User" AND
IF wsA...Codes Column Q = "Office" AND
IF ws...Codes Column R = "G2" AND
IF ws...Codes Column AA = wsDest Column AB
THEN
Copy the value from I (wsAvailabilityCodes) to AC (wsDest)
Copy the value from K to AA
Copy the value from A to AZ

hope the above explains a bit more

 

[Alex Blakenburg]

That does not provide a unique link between the 2 tables. A line on dest will match multiple lines on Availability and the reverse is true as well

 

[Razor_Rob]

Thats how I manually filter the Availablity I filter Column B, then filter column P, column Q, column R and Column AA

then I get one row that matches the above filtering

 

[Alex Blakenburg]

My understanding is that your filter would produce this, in Availibility

20220928 VBA Dictionary with Criteria Razor_Rob.xlsm
	A	B	C	D	E	F	G	H
11	A	B	I	K	P	Q	R	AA
12	3711	ABC12345-Sample	5	1	User	Office	G2	502
13	3711	ABC12345-Sample	1	2	User	Office	G2	504
Availability

And the only thing you have to go on from Dest is this:

20220928 VBA Dictionary with Criteria Razor_Rob.xlsm
	L
11	Y
12	ABC12345
13	ABC12345
Availability

That would mean for this example there would be 2 matches for each of the rows in Dest, with no way of knowing which lines up with which.
And this is for the scenario that both Availibility (after the filter) and Dest have the same number of records and you have said nothing to suggest that will always be the case.

 

[Razor_Rob]

No in wsDest there's data in Y and AB

Y	AA	AB	AC	AZ
ABC12345		502
ABC12345		504

 

[Alex Blakenburg]

That sounds more promising, so we will try linking on those 2 fields.

 

[Razor_Rob]

Yes please, and thanks very much for your patience, really appreciate it

 

[Alex Blakenburg]

See if this works for you.

Sub PartialMatch()

    Dim Col2 As Range
    Dim Dict1 As Object
    
    Dim wsAvailabilityCodes As Worksheet, wsDest As Worksheet
    Dim lrowAvail As Long, iRow As Long
    Dim arrAvail As Variant
    Dim dictKey_ID_pt1 As String, dictKey_ID_pt2 As String, dictKey As String
    
    Set wsAvailabilityCodes = Worksheets("Availability")
    With wsAvailabilityCodes
        lrowAvail = .Range("B" & Rows.Count).End(xlUp).Row
        arrAvail = .Range("A5:AA" & lrowAvail)                   ' XXX Increased no of columns
    End With
    
    Set wsDest = Worksheets("Destination")
            
    Set Dict1 = CreateObject("scripting.dictionary")
    For iRow = 1 To UBound(arrAvail)
    
        If arrAvail(iRow, 16) = "User" And arrAvail(iRow, 17) = "Office" And arrAvail(iRow, 18) = "G2" Then
            dictKey_ID_pt1 = Split(arrAvail(iRow, 2), "-")(0)       ' Col B - Only take the Code field up to the "-"
            dictKey_ID_pt2 = arrAvail(iRow, 27)                     ' Col AA
            dictKey = dictKey_ID_pt1 & "|" & dictKey_ID_pt2
            Dict1(dictKey) = iRow
        End If
    Next iRow
                
    With wsDest
        For Each Col2 In .Range("Y3", .Range("Y" & Rows.Count).End(xlUp))
            dictKey_ID_pt1 = Col2.Value             ' Column Y
            dictKey_ID_pt2 = Col2.Offset(, 3)       ' Column AB
            dictKey = dictKey_ID_pt1 & "|" & dictKey_ID_pt2
            
            If Dict1.exists(dictKey) Then
                iRow = Dict1(dictKey)
                Col2.Offset(, 1).Value = arrAvail(iRow, 1)
                Col2.Offset(, 2).Value = arrAvail(iRow, 9)
                Col2.Offset(, 4).Value = arrAvail(iRow, 11)
            End If
        Next Col2
    End With

End Sub

 

[Razor_Rob]

Thank you very much that works perfectly!