Wonder if the last piece of code by Kalak has worked as I was working on a similar issue and found that I used a different approach.
At a high level the process is
- create a temporary worksheet to hold the results
- using the data worksheet use vlookup iteratively on each row to match A in B
- if a match exists then iteratively use vlookup across the remaining columns
- put he results from the vlookup into the temporary worksheet
- rename the temporary worksheet
I chose this approach for my piece of work because I had such a headache with shifting rows up and down, accidentally overwriting data or not clearing cells.
Below is the attached code and modified to work with your sample dataset that you provided with your first post.
I'm not sure if this is the most efficient method in terms of speed with regards to dictionary vs vlookup, but I guess is depends the size of your dataset.
If you have already found another solution then that is great.
Public Sub MatchIt()
Dim wkData As Worksheet
Dim wkTemp As Worksheet
Dim iLastCol As Integer
Dim iLastRow As Integer
Dim iHeaderRow As Integer
Dim iRowCounter As Integer
Dim iColCounter As Integer
Dim sLookupRange As String
Dim vKey As Variant
Dim result As Variant
iHeaderRow = 1
sLookupRange = "B:D"
iRowCounter = iHeaderRow + 1
'get the data work sheet
Set wkData = Worksheets("Data")
'get the last column
iLastCol = wkData.Cells.Find("*", SearchOrder:=xlByColumns, _
LookIn:=xlValues, SearchDirection:=xlPrevious).Column
'get last row
iLastRow = wkData.Range("A" & Rows.Count).End(xlUp).Row
'create a temporary sheet
Set wkTemp = Worksheets.Add
'copy the header across
wkData.Rows(1).Copy
wkTemp.Range("A1").PasteSpecial (xlPasteValues)
'iterate through the rows doing a vlookup
'copy corresponding / vlookup corresponding from data to temp data worksheet
While iRowCounter <= iLastRow
vKey = wkData.Cells(iRowCounter, 1).Value
result = vlookupVBA(vKey, wkData, sLookupRange, 1)
wkTemp.Cells(iRowCounter, 1) = vKey
'loop through remaining columns when matching key
If result <> "#N/A" Then
iColCounter = 1
While iColCounter < iLastCol
wkTemp.Cells(iRowCounter, iColCounter + 1) = vlookupVBA(vKey, wkData, sLookupRange, iColCounter)
iColCounter = iColCounter + 1
Wend
End If
iRowCounter = iRowCounter + 1
Wend
'delete the data worksheet and rename the temp worksheet
End Sub
'copied from forum and modified to include the worksheet by ref
Function vlookupVBA(lookupValue As Variant, ByRef wk As Worksheet, rangeString As String, colOffset As Integer)
vlookupVBA = "#N/A"
On Error Resume Next
Dim table_lookup As Range
Set table_lookup = wk.Range(rangeString)
vlookupVBA = Application.WorksheetFunction.VLookup(lookupValue, table_lookup, colOffset, False)
End Function
Bookmarks