Indexing and matching based on complex criteria

MurdochQuill

Board Regular
Joined
Nov 21, 2020
Messages
84
Office Version
  1. 365
Platform
  1. Windows
Hi.

I have a difficult one for you all.

I'm trying to translate some data to different columns in VBA based on some complex criteria. Not sure on the formatting to search this stuff so hopefully someone can help ! :)

What I would like to do is feed in raw data ID's under Name/Desc/Type in F column. I would like to then match them to the A, B and C columns, then I would like to copy/paste the G column "Value" into the corresponding D "Value" column where there is a match.

Here is an example sheet:
Book1
ABCDEFG
1NameDescriptionTYPEVALUE:Name/DESC/TYPEValue:
2AAG3YTR5-G412
3DDCCG3WER3-G312
4G564CCG3JHG6-G633
5BBG3JHG6-G519
6G544CCG3I78-G645
7G55CCG3I78-G3324
8G55CCG6HFH4-G5560
9I78CCG3G564-G343
10I78CCG6G55-G645
11JHG6CCG5G55-G3345
12JHG6CCG6G544-G355
13HFH4CCG5FGH4-G32
14456DCCG5DD-G336
15456SCCG3BB-G356
16WER3CCG3AA-G368
17FGH4CCG3456S-G33
18YTR5CCG4456D-G54
Sheet1



So here are a bunch of rules I need to work out when copying over:
  • Description AA will always ignore any input name, but as long as we match the description that's ok.
  • Description BB same as above.
  • Description CC will always need to have name matched on column F before the "-XX" suffix.
  • Type will always be a suffix in the form of "-XX".
  • Both name and suffix need to match in order to send from column G to column D.
Here is what it should look like when complete:
Book1
ABCDEFG
1NameDescriptionTYPEVALUE:Name/DESC/TYPEValue:
2AAG368YTR5-G412
3DDCCG336WER3-G312
4G564CCG343JHG6-G633
5BBG356JHG6-G519
6G544CCG355I78-G645
7G55CCG3345I78-G3324
8G55CCG645HFH4-G5560
9I78CCG3324G564-G343
10I78CCG645G55-G645
11JHG6CCG519G55-G3345
12JHG6CCG633G544-G355
13HFH4CCG5560FGH4-G32
14456DCCG54DD-G336
15456SCCG33BB-G356
16WER3CCG312AA-G368
17FGH4CCG32456S-G33
18YTR5CCG412456D-G54
Sheet1
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Any particular reason you need a macro, as this can easily be one with a formula.
+Fluff 1.xlsm
ABCDEFG
1NameDescriptionTYPEVALUE:Name/DESC/TYPEValue:
2AAG368YTR5-G412
3DDCCG336WER3-G312
4G564CCG343JHG6-G633
5BBG356JHG6-G519
6G544CCG355I78-G645
7G55CCG3345I78-G3324
8G55CCG645HFH4-G5560
9I78CCG3324G564-G343
10I78CCG645G55-G645
11JHG6CCG519G55-G3345
12JHG6CCG633G544-G355
13HFH4CCG5560FGH4-G32
14456DCCG54DD-G336
15456SCCG33BB-G356
16WER3CCG312AA-G368
17FGH4CCG32456S-G33
18YTR5CCG412456D-G54
19
Main
Cell Formulas
RangeFormula
D2:D18D2=XLOOKUP(IF(OR(B2={"AA","BB"}),B2,A2)&"-"&C2,$F$2:$F$18,$G$2:$G$18,"",0)
 
Upvote 0
Any particular reason you need a macro, as this can easily be one with a formula.
+Fluff 1.xlsm
ABCDEFG
1NameDescriptionTYPEVALUE:Name/DESC/TYPEValue:
2AAG368YTR5-G412
3DDCCG336WER3-G312
4G564CCG343JHG6-G633
5BBG356JHG6-G519
6G544CCG355I78-G645
7G55CCG3345I78-G3324
8G55CCG645HFH4-G5560
9I78CCG3324G564-G343
10I78CCG645G55-G645
11JHG6CCG519G55-G3345
12JHG6CCG633G544-G355
13HFH4CCG5560FGH4-G32
14456DCCG54DD-G336
15456SCCG33BB-G356
16WER3CCG312AA-G368
17FGH4CCG32456S-G33
18YTR5CCG412456D-G54
19
Main
Cell Formulas
RangeFormula
D2:D18D2=XLOOKUP(IF(OR(B2={"AA","BB"}),B2,A2)&"-"&C2,$F$2:$F$18,$G$2:$G$18,"",0)

Thank you for your help Fluff. Yeah the current solution is done with cell formulas, but I would like to use as little in cell formulae as possible. That being said, I'm also interested in how to approach these problems in VBA.

(Worst case scenario I dump a formula in, then convert to values).
 
Upvote 0
Ok, how about
VBA Code:
Sub MurdochQuill()
   Dim Cl As Range
   Dim Txt As String
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("F2", Range("F" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 1).Value
      Next Cl
      For Each Cl In Range("D2:D" & Range("A" & Rows.Count).End(xlUp).Row)
         Select Case Cl.Offset(, -2).Value
            Case "AA", "BB"
               Txt = Cl.Offset(, -2).Value & "-" & Cl.Offset(, -1).Value
            Case Else
               Txt = Cl.Offset(, -3).Value & "-" & Cl.Offset(, -1).Value
         End Select
         If .Exists(Txt) Then Cl.Value = .Item(Txt)
      Next Cl
   End With
End Sub
 
Upvote 0
Ok, how about
VBA Code:
Sub MurdochQuill()
   Dim Cl As Range
   Dim Txt As String
 
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("F2", Range("F" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 1).Value
      Next Cl
      For Each Cl In Range("D2:D" & Range("A" & Rows.Count).End(xlUp).Row)
         Select Case Cl.Offset(, -2).Value
            Case "AA", "BB"
               Txt = Cl.Offset(, -2).Value & "-" & Cl.Offset(, -1).Value
            Case Else
               Txt = Cl.Offset(, -3).Value & "-" & Cl.Offset(, -1).Value
         End Select
         If .Exists(Txt) Then Cl.Value = .Item(Txt)
      Next Cl
   End With
End Sub
This is excellent!
Say I wanted to grab this data from elsewhere, F & G columns from Sheet 2 to put into column D on a Destination sheet, I could:
Set SrcSheet = ActiveWorkbook.Sheets("Sheet2")
Set DstSheet = ActiveWorkbook.Sheets("Sheet1")

I see that you created an object using the F column, I'm not sure how to direct this to the destination sheet without breaking your code.
 
Upvote 0
You can do that like
VBA Code:
Sub MurdochQuill()
   Dim Cl As Range
   Dim Txt As String
   Dim wsSrc As Worksheet, wsDest As Worksheet
   Set wsSrc = Sheets("Sheet1")
   Set wsDest = Sheets("Sheet2")
   
   With CreateObject("scripting.dictionary")
      For Each Cl In wsSrc.Range("F2", wsSrc.Range("F" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 1).Value
      Next Cl
      For Each Cl In wsDest.Range("D2:D" & wsDest.Range("A" & Rows.Count).End(xlUp).Row)
         Select Case Cl.Offset(, -2).Value
            Case "AA", "BB"
               Txt = Cl.Offset(, -2).Value & "-" & Cl.Offset(, -1).Value
            Case Else
               Txt = Cl.Offset(, -3).Value & "-" & Cl.Offset(, -1).Value
         End Select
         If .Exists(Txt) Then Cl.Value = .Item(Txt)
      Next Cl
   End With
End Sub
 
Upvote 0
Solution
You can do that like
VBA Code:
Sub MurdochQuill()
   Dim Cl As Range
   Dim Txt As String
   Dim wsSrc As Worksheet, wsDest As Worksheet
   Set wsSrc = Sheets("Sheet1")
   Set wsDest = Sheets("Sheet2")
 
   With CreateObject("scripting.dictionary")
      For Each Cl In wsSrc.Range("F2", wsSrc.Range("F" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 1).Value
      Next Cl
      For Each Cl In wsDest.Range("D2:D" & wsDest.Range("A" & Rows.Count).End(xlUp).Row)
         Select Case Cl.Offset(, -2).Value
            Case "AA", "BB"
               Txt = Cl.Offset(, -2).Value & "-" & Cl.Offset(, -1).Value
            Case Else
               Txt = Cl.Offset(, -3).Value & "-" & Cl.Offset(, -1).Value
         End Select
         If .Exists(Txt) Then Cl.Value = .Item(Txt)
      Next Cl
   End With
End Sub

You have been incredibly helpful Fluff. A true gentleman and scholar :D

I like the idea of using column offsets to work around the problem.
 
Upvote 0
You're welcome & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,224,828
Messages
6,181,210
Members
453,023
Latest member
alabaz

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top