I find this script handy for preparing ad-hoc reporting. Using two sets of unique identifiers, it allows you to lookup multiple columns of data with the Index Match function. I welcome any feedback or suggestions for improvement.
Sub MatchMaster_PRO()
'Peter Domanico (June 2018)
'this script helps simplify the use of Excel's Index Match function
'place this script in your personal macro workbook and assign it to a button
'use it to pull data between two worksheets that share unique identifiers
'dim ranges
Dim ValuesToPull As Range
Dim TargetIDs As Range
Dim SourceIDs As Range
Dim MyRange As Range
'dim worksheets
Dim Source1 As Worksheet
Dim Target1 As Worksheet
Dim Source2 As Worksheet
Dim Target2 As Worksheet
'input box dims
Dim Prompt1 As String
Dim Prompt2 As String
Dim Prompt3 As String
Dim Prompt4 As String
Dim Title1 As String
Dim Title2 As String
Dim Title3 As String
Dim Title4 As String
'set prompts
Prompt1 = "Select values to pull (1 or more columns)"
Prompt2 = "Select unique IDs on target sheet (1 column only)"
Prompt3 = "Select unique IDs on source sheet (1 column only)"
Prompt4 = "Select any range on target sheet"
'set titles
Title1 = "Source Sheet"
Title2 = "Target Sheet"
Title3 = "Source Sheet"
Title4 = "Target Sheet"
'error handling
On Error GoTo OuttaHere
'input boxes
Set SourceIDs = Application.InputBox(Prompt3, Title3, Type:=8)
Set Source1 = SourceIDs.Worksheet
SourceIDcolumn = SourceIDs.Column
LastSourceID = Source1.Cells(Rows.Count, SourceIDcolumn).End(xlUp).Row
Source1.Activate
Set ValuesToPull = Application.InputBox(Prompt1, Title1, Type:=8)
Set Source2 = ValuesToPull.Worksheet
LastValue = LastSourceID
Source2.Activate
Set TargetIDs = Application.InputBox(Prompt2, Title2, Type:=8)
Set Target1 = TargetIDs.Worksheet
TargetIDcolumn = TargetIDs.Column
LastTargetID = Target1.Cells(Rows.Count, TargetIDcolumn).End(xlUp).Row '<~~ also use this for MyRange
Target1.Activate
Set MyRange = Application.InputBox(Prompt4, Title4, Type:=8)
Set Target2 = MyRange.Worksheet
MyColumn = MyRange.Column
Target2.Activate
'convert input to Range Cells format
With Source1
Set SourceIDs = .Range(.Cells(1, SourceIDcolumn), .Cells(LastSourceID, SourceIDcolumn))
End With
With Target1
Set TargetIDs = .Range(.Cells(1, TargetIDcolumn), .Cells(LastTargetID, TargetIDcolumn))
End With
Dim rng As Range
For Each rng In ValuesToPull.Columns
ValuesColumn = rng.Column
NextColumn = Target2.Cells(1, Columns.Count).End(xlToLeft).Column + 1
With Source2
Set ValuesToPull = .Range(.Cells(1, ValuesColumn), .Cells(LastValue, ValuesColumn))
End With
With Target2
Set MyRange = .Range(.Cells(1, NextColumn), .Cells(LastTargetID, NextColumn))
End With
MyRange = Application.index(ValuesToPull, Application.Match(TargetIDs, SourceIDs, 0))
Next rng
OuttaHere:
ActiveWorkbook.ActiveSheet.Columns.AutoFit
End Sub