Using VBA Match and Index function

DarrenSmith1981 · Feb 24th 2021

Mod note: Cross-posted here: Add ranges to match and index functions | MrExcel Message Board

Trying to use match & Index with specified ranges

Match, Index & function connect or talk to each other?

See code below

Code

Private Sub Jobcard_Demands_Click()


If Jobcard_Demands = ("Drawing No`s Update") Then


Dim matchRange As Range
Dim ODict As Object
Dim PartsListLastRow As Long, DestLastRow As Long
Dim LookupRange As Range
Dim i As Integer
Dim wsSource As Worksheet, wsDest As Worksheet


Set wsSource = ThisWorkbook.Worksheets("Parts List")
Set wsDest = ThisWorkbook.Worksheets("Job Card Master")


PartsListLastRow = wsSource.Range("A" & Rows.Count).End(xlUp).Row
DestLastRow = wsDest.Range("A" & Rows.Count).End(xlUp).Row


'This holds the lookup range (including both the lookup key
'column and the value column)
Set matchRange = wsSource.Range("E1:F" & PartsListLastRow)


'Get a dictionary of all the lookup values. The function, as
'defined below, takes the range as well as the relative column
'of the keys and values. In our case, the first column of our
'range has the keys, and the second has the values
Set ODict = GetDictionary(matchRange, 5, 6)


'Below, define the lookup range. In your specific code, this
'varies based on the combobox value, but I think you'll be able
'to figure out how to define it (I'm just hardcoding mine
Set LookupRange = wsDest.Range("A1:A" & DestLastRow)


'Loop over the lookup range
For i = 1 To DestLastRow
'Since the GetPartInfo function handles cases where there isn't a match
' (it returns a blank string), you don't have to use an if/else statement
wsDest.Range("B" & i).Value = GetPartInfo(ODict, wsDest.Range("E" & i).Value)
Next i
End If
End Sub


Private Function GetDictionary(rng As Range, keyCol As Long, valCol As Long) As Object
Dim sht As Worksheet
Dim rCell As Range
Dim ODict As Object


Set sht = rng.Parent
Set ODict = CreateObject("Scripting.Dictionary")


For Each rCell In rng.Columns(keyCol).Cells
If Not ODict.Exists(rCell.Offset(, keyCol - 1).Value) Then
ODict.Add rCell.Offset(, keyCol - 1).Value, rCell.Offset(, valCol - 1).Value
End If
Next rCell


Set GetDictionary = ODict
End Function


'This is just a helper function to de-clutter the main subroutine. Returns an
' empty string in cases where the part doesn't exist in the dictionary
Private Function GetPartInfo(ByRef ODict As Object, sKey As String)
Dim Output As String


Output = ""


If ODict.Exists(sKey) Then
Output = ODict(sKey)
End If


GetPartInfo = Output
End Function

Display More

**royUK** · Feb 24th 2021

Why are you needing the formula in VBA? Explain what your needs are and there may be a better way

DarrenSmith1981 · Feb 25th 2021

Thanks for replying

What I need is drawing No.s of the Parts list sheet column F into the job card Master sheet column B.

The column E on both sheets match then the Drawing No in column B in Job Card Master to fill with the correct Drawing number from Parts List sheet Column F.

Trust that makes sense

**rory** · Feb 25th 2021

You've already got code that does that, so why do you need a different version?

DarrenSmith1981 · Feb 25th 2021

When I try to run it using F8 it seems to jump over the code?

This code below seems to not work?

Set matchRange = wsSource.Range("E1:F" & PartsListLastRow)

**rory** · Feb 25th 2021

The code is supposed to be triggered by you changing the value of a combobox. What was wrong with the version you said was working over at the other forum?

DarrenSmith1981 · Feb 25th 2021

That code filled in all cells in column B but I need it to fill in the specified Ranges.

There are pages 1-5 which there are 4 rows between each page

**rory** · Feb 25th 2021

There is no mention of any specific ranges in your code or your question, so perhaps you need to clarify...

DarrenSmith1981 · Feb 25th 2021

Sorry yes, should have been clearer. But it does require using ranges

**rory** · Feb 25th 2021

I'm not sure you understand what I mean by "clarify"...

DarrenSmith1981 · Feb 25th 2021

What do you mean by Clarify. I am trying to make it clear?

**rory** · Feb 25th 2021

Saying "it does require ranges" really doesn't make anything clearer. Your code already uses ranges. What ranges do you mean? How should they be used?

DarrenSmith1981 · Feb 25th 2021

The ranges are pages 1 to 5

The ranges need the Drawing numbers filled in from the Parts List sheet but not the 4 rows in between the pages.

These are the ranges not part of this code but shows what I mean

Select Case cmb.Value

Case ("Break Lines 1 Page Job Card")

colorAbove ws.Range("A13:Q" & LastRow)

Case ("Break Lines 2 Page Job Card")

colorAbove ws.Range("A13:Q61")

colorAbove ws.Range("A66:Q" & LastRow)

Case ("Break Lines 3 Page Job Card")

colorAbove ws.Range("A13:Q61")

colorAbove ws.Range("A66:Q122")

colorAbove ws.Range("A127:Q" & LastRow)

Case ("Break Lines 4 Page Job Card")

colorAbove ws.Range("A13:Q61")

colorAbove ws.Range("A66:Q122")

colorAbove ws.Range("A127:Q183")

colorAbove ws.Range("A188:Q" & LastRow)

Case ("Break Lines 5 Page Job Card")

colorAbove ws.Range("A13:Q61")

colorAbove ws.Range("A66:Q122")

colorAbove ws.Range("A127:Q183")

colorAbove ws.Range("A188:Q244")

colorAbove ws.Range("A249:Q" & LastRow)

End Select

**rory** · Feb 25th 2021

Does this code always need to process all those ranges, or does it depend on the value of whatever control cmb is, like that example?

DarrenSmith1981 · Feb 25th 2021

The choice is from the cmb control

**rory** · Feb 25th 2021

Try something like this:

Code

Private Sub Jobcard_Demands_Click()
If Jobcard_Demands = ("Drawing No`s Update") Then
Dim matchRange As Range
Dim ODict As Object
Dim PartsListLastRow As Long, DestLastRow As Long
Dim wsSource As Worksheet, wsDest As Worksheet
Set wsSource = ThisWorkbook.Worksheets("Parts List")
Set wsDest = ThisWorkbook.Worksheets("Job Card Master")
PartsListLastRow = wsSource.Range("A" & Rows.Count).End(xlUp).Row
DestLastRow = wsDest.Range("A" & Rows.Count).End(xlUp).Row
'This holds the lookup range (including both the lookup key
'column and the value column)
Set matchRange = wsSource.Range("E1:F" & PartsListLastRow)
'Get a dictionary of all the lookup values. The function, as
'defined below, takes the range as well as the relative column
'of the keys and values. In our case, the first column of our
'range has the keys, and the second has the values
Set ODict = GetDictionary(matchRange, 5, 6)
'Below, define the lookup range. In your specific code, this
'varies based on the combobox value, but I think you'll be able
'to figure out how to define it (I'm just hardcoding mine
Select Case cmb.Value
Dim dataRange As Range
Case ("Break Lines 1 Page Job Card")


Set dataRange = wsDest.Range("A13:Q" & LastRow)


Case ("Break Lines 2 Page Job Card")


Set dataRange = wsDest.Range("A13:Q61,A66:Q" & LastRow)


Case ("Break Lines 3 Page Job Card")


Set dataRange = wsDest.Range("A13:Q61,A66:Q122,A127:Q" & LastRow)


Case ("Break Lines 4 Page Job Card")


Set dataRange = wsDest.Range("A13:Q61,A66:Q122,A127:Q183,A188:Q" & LastRow)


Case ("Break Lines 5 Page Job Card")


Set dataRange = wsDest.Range("A13:Q61,A66:Q122,A127:Q183,A188:Q244,A249:Q" & LastRow)


End Select
If Not dataRange Is Nothing Then
Dim area As Range
For Each area In dataRange.Areas
GetPartInfoForRange area.Columns(5), area.Columns(2), ODict
Next area
End If
End If
End Sub
Sub GetPartInfoForRange(lookupRange As Range, outputRange As Range, DataSet As Object)
Dim cell As Range
Dim counter As Long
For Each cell In lookupRange.Cells
counter = counter + 1
outputRange.Cells(counter) = GetPartInfo(DataSet, cell.Value)
Next cell
'Since the GetPartInfo function handles cases where there isn't a match
' (it returns a blank string), you don't have to use an if/else statement
wsDest.Range("B" & i).Value = GetPartInfo(ODict, wsDest.Range("E" & i).Value)


End Sub
Private Function GetDictionary(rng As Range, keyCol As Long, valCol As Long) As Object
Dim sht As Worksheet
Dim rCell As Range
Dim ODict As Object
Set sht = rng.Parent
Set ODict = CreateObject("Scripting.Dictionary")
For Each rCell In rng.Columns(keyCol).Cells
If Not ODict.Exists(rCell.Offset(, keyCol - 1).Value) Then
ODict.Add rCell.Offset(, keyCol - 1).Value, rCell.Offset(, valCol - 1).Value
End If
Next rCell
Set GetDictionary = ODict
End Function
'This is just a helper function to de-clutter the main subroutine. Returns an
' empty string in cases where the part doesn't exist in the dictionary
Private Function GetPartInfo(ByRef ODict As Object, sKey As String)
Dim Output As String
Output = ""
If ODict.Exists(sKey) Then
Output = ODict(sKey)
End If
GetPartInfo = Output
End Function

Display More

DarrenSmith1981 · Feb 25th 2021

You're on the right track but?

This part of the code below, wsDest.Range("B" & i).Value = GetPartInfo(ODict, wsDest.Range("E" & i).Value) says "method range of object worksheet Failed?"

Sub GetPartInfoForRange(lookupRange As Range, outputRange As Range, DataSet As Object)

Dim cell As Range

Dim counter As Long

Dim ODict As Object

Dim wsDest As Worksheet

Dim i As Integer

Set wsDest = ThisWorkbook.Worksheets("Job Card Master")

For Each cell In lookupRange.Cells

counter = counter + 1

outputRange.Cells(counter) = GetPartInfo(DataSet, cell.Value)

Next cell

wsDest.Range("B" & i).Value = GetPartInfo(ODict, wsDest.Range("E" & i).Value)

End Sub

**rory** · Feb 25th 2021

Sorry, that line should have been deleted.

DarrenSmith1981 · Feb 25th 2021

I`ve taken it away but it`s still not working. Nothing happens.

Would it help if I sent you my workbook

**rory** · Feb 25th 2021

It couldn't hurt.

Using VBA Match and Index function

Participate now!

Share

Tags