Link to home
Start Free TrialLog in
Avatar of Luis Diaz
Luis DiazFlag for Colombia

asked on

VBA: perform index match based on config sheet with two additional parameters.

Hello experts,

I have the following excellent procedure which allows me to perform multiple index match based on the following configuration sheet:
User generated image
'===> Run index match function in order to bring values from multiple sheets


Sub RunIndexMatch()
    Dim wsConfig As Worksheet, wsResult As Worksheet, wsTargetSheet As Worksheet
    Dim sSheetName As String, sTargetColumn As String, sCompareColumn As String, sMatchColumn As String, sDestinationColumn, sSheetName2 As String
    Dim rgTarget As Range, rgCompare  As Range, rgMatch As Range, c As Range
    Dim rw As Integer, MaxRowTargetSheet As Long
    Dim vMatchRow As Variant
    Dim Flag As Integer, MatchCount As Long
    
    CheckConfigSheet
    
    Set wsConfig = Worksheets("3.Parameter-Index-Match")
    Application.ScreenUpdating = False
    For rw = 2 To wsConfig.Range("A1").CurrentRegion.Rows.Count
        sSheetName = wsConfig.Range("A" & rw)
        Set wsTargetSheet = Worksheets(sSheetName)
        sSheetName2 = wsConfig.Range("F" & rw)
        Set wsResult = Worksheets(sSheetName2)
        MaxRowTargetSheet = wsTargetSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
        sTargetColumn = wsConfig.Range("B" & rw)
        sCompareColumn = wsConfig.Range("C" & rw)
        sMatchColumn = wsConfig.Range("D" & rw)
        sDestinationColumn = wsConfig.Range("E" & rw)
        Flag = wsConfig.Range("G" & rw)
        MatchCount = 0
        wsTargetSheet.Select
        Set rgTarget = wsTargetSheet.Range(sTargetColumn & "2:" & sTargetColumn & MaxRowTargetSheet)
        Set rgMatch = wsTargetSheet.Range(sMatchColumn & "2:" & sMatchColumn & MaxRowTargetSheet)
        wsResult.Select
        Set rgCompare = wsResult.Range(sCompareColumn & "2", Range(sCompareColumn & Rows.Count).End(xlUp))
        For Each c In rgCompare
            vMatchRow = Application.Match(c, rgMatch, 0)
            If IsNumeric(vMatchRow) Then
                If Flag = 0 Then
                    MatchCount = MatchCount + 1
                    wsResult.Range(sDestinationColumn & c.Row).Clear
                    wsResult.Range(sDestinationColumn & c.Row) = Application.WorksheetFunction.Index(rgTarget, vMatchRow, 1)
                Else
                    If wsResult.Range(sDestinationColumn & c.Row) = "" Then
                        MatchCount = MatchCount + 1
                        wsResult.Range(sDestinationColumn & c.Row) = Application.WorksheetFunction.Index(rgTarget, vMatchRow, 1)
                    End If
                End If
            End If
        Next c
        wsConfig.Range("H" & rw) = MatchCount
    Next rw
    wsConfig.Select
End Sub

Sub CheckConfigSheet()
    Dim wsConfig As Worksheet, ws As Worksheet, rw As Integer, col As Integer, i As Integer, WarningText As String
    Set wsConfig = Worksheets("3.Parameter-Index-Match")
    For rw = 2 To wsConfig.Range("A1").CurrentRegion.Rows.Count
        i = 0
        For Each ws In Worksheets
            If wsConfig.Range("A" & rw) <> "" Then
                If UCase(ws.Name) = UCase(wsConfig.Range("A" & rw)) Then
                    i = i + 1
                End If
                If UCase(ws.Name) = UCase(wsConfig.Range("F" & rw)) Then
                    i = i + 1
                End If
            End If
        Next ws
        For col = 2 To 5
            If wsConfig.Cells(rw, col) <> "" And Len(wsConfig.Cells(rw, col)) <= 2 Then
                If WorksheetFunction.IsText(wsConfig.Cells(rw, col)) Then
                    i = i + 1
                End If
            End If
        Next col
        If wsConfig.Range("G" & rw) = 0 Or wsConfig.Range("G" & rw) = 1 Then
            i = i + 1
        End If
        If i <> 7 Then
            WarningText = "Warning" & Chr(10) & "Data entered in Config Sheet row " & CStr(rw) & " is not consistent, please check that:"
            WarningText = WarningText & Chr(10) & "1-Target/Comparedvalue and Destination  Sheets exist or there is a misspelled mistake or you haven't entered data."
            WarningText = WarningText & Chr(10) & "Required columns entered in Range(B:E) are alphabetical and not numeric."
            WarningText = WarningText & Chr(10) & "Required flag value is not 0 or 1"
            WarningText = WarningText & Chr(10) & Chr(10) & "Program stop"
            MsgBox WarningText, vbCritical
            End
        End If
    Next rw
End Sub

Open in new window


I would like to add two additional parameters:

  • Column I: if value equals 1 skip line else apply the procedure:

  • ColumnJ: Destination Range (A1) of Destination Sheet.

If you have questions, please contact me.

Thank you again for your help.
Avatar of Professor J
Professor J

is it possible to upload you sample workbook?
Avatar of Luis Diaz

ASKER

Please find attached the sample workbook.
28966294_Dynamic-index-match-.xlsm
Hello,

Please let me know if you need additional information.
ASKER CERTIFIED SOLUTION
Avatar of Professor J
Professor J

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thank you very much for this proposal. I will test it tomorrow.
Thank you very much for this proposal.

I was able to test the last version and it works. I have just one remark. I don’t know if it is possible to include the already launch procedure before performing the header fill.
With the actual version the header is replaced thought the parameter already launched 1.
The idea is to avoid any modification when already launched parameter is equal to 1.

Thank you again for your help.
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Perfect. Thank you very much for your help.
you are most welcome. i am glad i was able to help.