VBA Excel: Perform index match dynamically based on a config Sheet v2

Option Explicit

Sub RunIndexMatch_revised()
    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
    
    CheckConfigSheet
    
    Set wsConfig = Worksheets("Config")
    Set wsResult = Worksheets("Result")
    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)
        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))
        wsResult.Range(sDestinationColumn & "2:" & sDestinationColumn & (rgCompare.Rows.Count + 1)).ClearContents
        For Each c In rgCompare
            vMatchRow = Application.Match(c, rgMatch, 0)
            If IsNumeric(vMatchRow) Then
                wsResult.Range(sDestinationColumn & c.Row) = Application.WorksheetFunction.Index(rgTarget, vMatchRow, 1)
            End If
        Next c
    Next rw
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("Config")
    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 i <> 6 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) & Chr(10) & "Program stop"
            MsgBox WarningText, vbCritical
            End
        End If
    Next rw
End Sub

Select allOpen in new window