Luis Diaz
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:
I would like to add two additional parameters:
If you have questions, please contact me.
Thank you again for your help.
I have the following excellent procedure which allows me to perform multiple index match based on the following configuration sheet:
'===> 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
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.
is it possible to upload you sample workbook?
ASKER
Please find attached the sample workbook.
28966294_Dynamic-index-match-.xlsm
28966294_Dynamic-index-match-.xlsm
ASKER
Hello,
Please let me know if you need additional information.
Please let me know if you need additional information.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thank you very much for this proposal. I will test it tomorrow.
ASKER
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.
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Perfect. Thank you very much for your help.
you are most welcome. i am glad i was able to help.