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

 

[DanteAmor]

You could put an example of what you have in the "wsDest" sheet and put in yellow what you want as a result. Use XL2BB tool to put examples.

 

[Razor_Rob]

Sorry my PC wont allow me to download XL2BB

wsDest comparing Column Y data from wsAvailabilityCodes if the value is the same as column B and 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

values copied over

wsAvailabilityCodes	wsDest
comparing B	to the value thats already in column Y
I	AC
K	AA
A	AZ

wsDest Data after

Y	Z	AA	AB	AC	.....	...	...	AZ
CPC123456		Value from Column K in wsAvailabilityCodes		Value from Column I in wsAvailabilityCodes				Value from Column A in wsAvailabilityCodes
UEE123456		1		2				2886
MEM12345-TEST		6		1				1234

 

[Alex Blakenburg]

See if this works for you.

Sub ModifiedCode()

    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
    
    Dim wsAvailabilityCodes As Worksheet, wsDest As Worksheet
    Dim lrowAvail As Long, i As Long
    Dim arrAvail As Variant
    Set wsAvailabilityCodes = Worksheets("Availability")
    With wsAvailabilityCodes
        lrowAvail = .Range("B" & Rows.Count).End(xlUp).Row
        arrAvail = .Range("A5:J" & lrowAvail)
    End With
    
    Set wsDest = Worksheets("Destination")
            
    Set Dict1 = CreateObject("scripting.dictionary")
    For i = 1 To UBound(arrAvail)
        Dict1(arrAvail(i, 2)) = i
    Next i
                
    With wsDest
        For Each Col2 In .Range("Y3", .Range("Y" & Rows.Count).End(xlUp))
            If Dict1.exists(Col2.Value) Then Col2.Offset(, 1).Value = arrAvail(Dict1(Col2.Value), 1)
            If Dict1.exists(Col2.Value) Then Col2.Offset(, 2).Value = arrAvail(Dict1(Col2.Value), 9)
            If Dict1.exists(Col2.Value) Then Col2.Offset(, 4).Value = arrAvail(Dict1(Col2.Value), 10)
        Next Col2
    End With

End Sub

 

[DanteAmor]

if the value is the same as column B and 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

Try this.
Adjust the name of your sheets.

Sub Searching_Multiple_Query()
  Dim wsCode As Worksheet, wsDest As Worksheet
  Dim dic As Object
  Dim a As Variant
  Dim i As Long
  Dim c As Range
  
  Set dic = CreateObject("Scripting.Dictionary")
  Set wsCode = Sheets("Sheet1")   'wsAvailabilityCodes sheet
  Set wsDest = Sheets("Sheet2")   'destination sheet
  
  a = wsCode.Range("A5:R" & wsCode.Range("B" & Rows.Count).End(3).Row).Value
  For i = 1 To UBound(a, 1)
    If a(i, 16) = "User" And a(i, 17) = "Office" And a(i, 18) = "G2" Then
      'Add to the dictionary only those that meet the conditions
      dic(a(i, 2)) = a(i, 1) & "|" & a(i, 9) & "|" & a(i, 11)
    End If
  Next
  
  For Each c In wsDest.Range("Y3", wsDest.Range("Y" & Rows.Count).End(3))
    If dic.exists(c.Value) Then
      wsDest.Range("AA" & c.Row).Value = Split(dic(c.Value), "|")(2)
      wsDest.Range("AC" & c.Row).Value = Split(dic(c.Value), "|")(1)
      wsDest.Range("AZ" & c.Row).Value = Split(dic(c.Value), "|")(0)
    End If
  Next
End Sub

 

[Razor_Rob]

Hi, seems to be working, will have to do more test
Thank you

Can I add something to the query please
How do I search a partial match in wsAvailabilityCodes column B
example ABC12345-Sample in Column B
and from wsDest column Y the value trying to match is ABC12345

wsAvailabilityCodes column B	wsDest column Y
ABC12345-Sample	ABC12345
EEE30015-Dash	EEE30015

Also out of topic if I have one of the workbook open already from the VBA code which has a line to open the VBA code errors - Run-time error '91' Object variable or With block variable not set
then highlights the code

Set wsAvailabilityCodes = wbAvailabilityCodes.Worksheets(1)

if the workboook is not open the code runs fine

 

[DanteAmor]

Hi, seems to be working, will have to do more test

I did the relevant tests to make it work.
But it is up to you to carry out all the tests you consider.

-----

How do I search a partial match in wsAvailabilityCodes column B

With the use of Dictionary it is not possible. I made the macro based on the fact that in your OP you are putting a dictionary, if you want partial searches, we must use another comparison option.
It's something you should mention in your OP.


Try this:

Sub Searching_Partial()
  Dim wsCode As Worksheet, wsDest As Worksheet
  Dim c As Range, f As Range
  
  Set wsCode = Sheets("Sheet1")   'wsAvailabilityCodes sheet
  Set wsDest = Sheets("Sheet2")   'destination sheet
  
  For Each c In wsDest.Range("Y3", wsDest.Range("Y" & Rows.Count).End(3))
    Set f = wsCode.Range("B:B").Find(c.Value & "*", , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      If wsCode.Range("P" & f.Row).Value = "User" And _
         wsCode.Range("Q" & f.Row).Value = "Office" And _
         wsCode.Range("R" & f.Row).Value = "G2" Then
        wsDest.Range("AA" & c.Row).Value = wsCode.Range("K" & f.Row).Value
        wsDest.Range("AC" & c.Row).Value = wsCode.Range("I" & f.Row).Value
        wsDest.Range("AZ" & c.Row).Value = wsCode.Range("A" & f.Row).Value
      End If
    End If
  Next
End Sub

There are other ways to search partially, but try the one above.

 

[Razor_Rob]

Hi

I tried the code above and there are no data in Columns AA and AC

 

[Alex Blakenburg]

Before we progress too far down a different Garden path. Can we rely on the format Code+"-"+Text.
If we trim off everything from the "-" is trimmed code from column B in the Availability sheet, still unique and a match for Destination Column Y ?
If not how do we know which one to pick up ?

 

[Razor_Rob]

Its not unique as it will have multiple lines like below, depending on P Q R and now I just realised AA as well. SORRY

wsAvailabilityCodes

A	B	I	K	P	Q	R	AA
3711	ABC12345-Sample	5	1	User	Office	G2	502
3711	ABC12345-Sample	1	2	User	Office	G2	504
3711	ABC12345-Sample	2	3	User	Work	G6	504
3711	ABC12345-Sample	1	1	User	Work	G2	502
3711	ABC12345-Sample	4	1	Company	Office	G2	505

wsDest should have

Y	AA	AB	AC	AZ
ABC12345	1	502	5	3711
ABC12345	2	504	1	3711

Column AB has been pre populated from copying data before this code.