I often use the Index Match function in daily reporting tasks. I was looking for a quicker way to utilize Index Match, as I find the formula cumbersome to enter. I ended up creating a userform that allows you to pull columns using Index Match between sheets in your open workbooks.
You can download the userform files here and a macro which launches the form here. Simply download these files to your computer and import them into your personal macro workbook to use the userform pictured below:
After some back and forth I decided to only accommodate Excel sheets with data beginning in the first row and first column (as indicated in the text box pictured in the interface). I had debated adding additional controls to adjust first rows and columns, but found this only helped me in limited situations and cluttered the interface.
I welcome any feedback on this userform as a concept as well as the relevant code which I have included below. This is a work in progress, so there are certainly some inconsistencies in the code below which I am working to address. With any luck this userform is helpful to anyone tasked with lots of vlookups, Index Matching, etc.
Cheers,
Peter
Public wb As Workbook
Public ws As Worksheet
Public SrcWbNm As String
Public TargWbNm As String
Public SrcShtNm As String
Public TargShtNm As String
Public strName As String
Public SourceIDcol As Integer
Public TargIDcol As Integer
'Peter Domanico, May 2019
Private Sub UserForm_Initialize()
'Declare variables and data types
Dim i As Single, j As Single
'Go through open workbooks and add names to comboboxes
For j = 1 To Workbooks.Count
If Workbooks(j).Name <> "PERSONAL.XLSB" Then
Me.CB_SourceWB.AddItem Workbooks(j).Name
Me.CB_TargetWB.AddItem Workbooks(j).Name
End If
Next j
'if only 1 workbook open, set as default value for comboboxes
If Me.CB_SourceWB.ListCount = 1 Then Me.CB_SourceWB.Text = Me.CB_SourceWB.List(0)
If Me.CB_TargetWB.ListCount = 1 Then Me.CB_TargetWB.Text = Me.CB_TargetWB.List(0)
End Sub
Private Sub CB_SourceWB_Change()
SrcWbNm = Me.CB_SourceWB.Text
Set wb = Workbooks(SrcWbNm)
Me.CB_SourceSheet.Clear
For Each ws In wb.Worksheets
strName = ws.Name
Me.CB_SourceSheet.AddItem strName
Next
'if only 1 worksheet in workbook, set as default value for comboboxes
If Me.CB_SourceSheet.ListCount = 1 Then Me.CB_SourceSheet.Text = Me.CB_SourceSheet.List(0)
End Sub
Private Sub CB_TargetWB_Change()
TargWbNm = Me.CB_TargetWB.Text
Set wb = Workbooks(TargWbNm)
Me.CB_TargetSheet.Clear
For Each ws In wb.Worksheets
strName = ws.Name
Me.CB_TargetSheet.AddItem strName
Next
'if only 1 worksheet in workbook, set as default value for comboboxes
If Me.CB_TargetSheet.ListCount = 1 Then CB_TargetSheet.Text = CB_TargetSheet.List(0)
End Sub
Private Sub CB_SourceSheet_Change()
SrcWbNm = Me.CB_SourceWB.Text
SrcShtNm = Me.CB_SourceSheet.Text
Me.CB_SourceID.Clear
Me.LB_SourceColumns.Clear
Select Case SrcShtNm
Case Is = ""
GoTo WeOut
Case Else
Set wb = Workbooks(SrcWbNm)
Set ws = wb.Worksheets(SrcShtNm)
LastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LastColumn
Me.CB_SourceID.AddItem ws.Cells(1, i).Text
Me.LB_SourceColumns.AddItem ws.Cells(1, i).Text
Next i
End Select
WeOut:
End Sub
Private Sub CB_TargetSheet_Change()
TargWbNm = Me.CB_TargetWB
TargShtNm = Me.CB_TargetSheet
Me.CB_TargetID.Clear
Select Case TargShtNm
Case Is = ""
GoTo WeOut
Case Else
Set wb = Workbooks(TargWbNm)
Set ws = wb.Worksheets(TargShtNm)
LastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LastColumn
Me.CB_TargetID.AddItem ws.Cells(1, i).Text
Next i
End Select
WeOut:
End Sub
Private Sub CB_SourceID_Change()
SourceIDcol = Me.CB_SourceID.ListIndex + 1
End Sub
Private Sub CB_TargetID_Change()
TargIDcol = Me.CB_TargetID.ListIndex + 1
End Sub
Private Sub CBTN_Pull_Columns_Click()
'performance
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'dims
Dim SourceWb As Workbook
Set SourceWb = Workbooks(SrcWbNm)
Dim TargWb As Workbook
Set TargWb = Workbooks(TargWbNm)
Dim SrcWs As Worksheet
Set SrcWs = SourceWb.Worksheets(SrcShtNm)
Dim TargWs As Worksheet
Set TargWs = TargWb.Worksheets(TargShtNm)
LastSrc = SrcWs.Cells(Rows.Count, SourceIDcol).End(xlUp).Row
LastTarg = TargWs.Cells(Rows.Count, TargIDcol).End(xlUp).Row
NextTargCol = TargWs.Cells(1, Columns.Count).End(xlToLeft).Column + 1
Dim ValuesToPull As Range, TargetIDs As Range, SourceIDs As Range, MyRange As Range
'count number of select items in LB_SourceColumns
Dim SelCt As Integer
For i = 0 To LB_SourceColumns.ListCount - 1
If LB_SourceColumns.Selected(i) = True Then SelCt = SelCt + 1
Next i
Select Case SelCt
Case Is = 0
MsgBox "No source columns selected!", vbCritical, "!!!"
GoTo CleanExit
End Select
'create array of columns from LB_SourceColumns
Dim arr() As Variant
ReDim arr(1 To SelCt)
j = 1
For i = 0 To LB_SourceColumns.ListCount - 1
If LB_SourceColumns.Selected(i) = True Then
arr(j) = i + 1
j = j + 1
End If
Next i
'set ranges for use in Index Match
With SrcWs
Set SourceIDs = .Range(.Cells(1, SourceIDcol), .Cells(LastSrc, SourceIDcol))
End With
With TargWs
Set TargetIDs = .Range(.Cells(1, TargIDcol), .Cells(LastTarg, TargIDcol))
End With
'perform Index Match
For i = LBound(arr) To UBound(arr)
With SrcWs
Set ValuesToPull = .Range(.Cells(1, arr(i)), .Cells(LastSrc, arr(i)))
End With
With TargWs
Set MyRange = .Range(.Cells(1, NextTargCol), .Cells(LastTarg, NextTargCol))
End With
MyRange = Application.index(ValuesToPull, Application.Match(TargetIDs, SourceIDs, 0))
TargWs.Cells(1, NextTargCol) = SrcWs.Cells(1, arr(i)) '<~copy header from source sheet
NextTargCol = NextTargCol + 1
Next i
'formatting
TargWb.Activate
With TargWs
.Columns.AutoFit
.Activate
End With
'performance
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.StatusBar = Ready
End With
CleanExit:
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then
Dim ans As VbMsgBoxResult
ans = MsgBox("Are you sure you want to exit?", vbYesNo, "???")
If ans = vbYes Then GoTo CleanExit Else Cancel = True
End If
CleanExit:
End Sub
