2
\$\begingroup\$

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: enter image description here

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
\$\endgroup\$
5
\$\begingroup\$

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.

However, a quick look at the form, implementing it into any workbook/application will be cumbersome and any user has to perform many steps - most accomplished Excel users will complete and auto-fill an INDEX/MATCH series in the time it would take to load and complete the form!

Your logic and general flow requires review - I am not going to go through it all. Try to understand your decision points and how this flows through each step. Break things down into helper functions if required. It looks like you coded this on the run and have not done your own review.

As an example, let us take the last event handler:

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

Firstly, anytime you use GoTo you raise a huge code stink. Flag it, review it! And then work out if your really need it. I doubt you ran through this routine in your mind because the last effective statement in the code says to go to the next line!

You also assign a Boolean in a complicated way. Let me rewrite this one for you:

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, "???")
        Cancel = Not (ans = vbYes)
    End If
End Sub

Oh, and Option Explicit at the top of modules, always. Not sure if you have used it in this case.

You haven't provided an example of how the results of the form would be used. Why so many public variables - the easy approach is to create a public property that returns a string that can be put into a formula property of a range.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.