Excel VBA: index match enhancements & adjustments
Hello experts,
I have the following procedure which allows me to perform index match based on range selection.
I would like to bring some enhancement and adjustment by talking as a reference the procedure reported at:
https://www.experts-exchan
1-Instead of selecting the various range from initial range to end range I would like to select any cell related to the range and display a msgbox confirmation of (Initial Range: End Range)
2-Finish the procedure with a msgbox Your reported range are the following:
Index Range: A2:Axx
Match Range: A2:Axx
Compared Range: A2:Axx
Are you sure that you want to proceed?
If not exit sub
I attached dummy file.
If you have questions, please contact me.
Thank you in advance for your help.
I have the following procedure which allows me to perform index match based on range selection.
Sub Index_Match()
Dim lCol As Long
Dim matchvalue As Range
Dim n1, n2, n3 As Long
On Error GoTo exit_sub
MsgBox ("WARNING: In order to properly run this procedure Check that:" & vbNewLine & _
"1-Select the initial range that is going to receive the index range" & vbNewLine & _
"2-Three ranges should have the same initial range")
Set target = Application.InputBox(prompt:="Select index range, range that you want to lookup in your output range: ", Title:="Range Select", Type:=8)
n1 = target.Parent.UsedRange.Row + target.Parent.UsedRange.Rows.Count - 1
MsgBox (n1)
Set target = Range(target.Cells(1, 1), target.EntireColumn.Cells(n1, 1))
Set matchvalue = Application.InputBox(prompt:="Select match range which is located in the same sheet of your output range", Title:="Range Select", Type:=8)
n2 = matchvalue.Parent.UsedRange.Row + matchvalue.Parent.UsedRange.Rows.Count - 1
MsgBox (n2)
Set matchvalue = Range(matchvalue.Cells(1, 1), matchvalue.EntireColumn.Cells(n2, 1))
Set comparedvalue = Application.InputBox(prompt:="Select compared range, this range is located in the same sheet of your index range", Title:="Range Select", Type:=8)
n3 = comparedvalue.Parent.UsedRange.Row + comparedvalue.Parent.Rows.Count - 1
MsgBox (n3)
Set comparedvalue = Range(comparedvalue.Cells(1, 1), comparedvalue.EntireColumn.Cells(n3, 1))
lCol = ActiveCell.Column - matchvalue.Column
For Each c In matchvalue
If IsNumeric(Application.Match(c, comparedvalue, 0)) Then
c.Offset(0, lCol).Value = Application.WorksheetFunction.Index(target, Application.WorksheetFunction.Match(c, comparedvalue, 0), 0)
End If
Next c
exit_sub:
End SubI would like to bring some enhancement and adjustment by talking as a reference the procedure reported at:
https://www.experts-exchan
Sub Is_In_Is_Na()
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim RngToCompare As Range, RngToCompareWith As Range, c As Range
Dim colLetterSource As String, colLetterTarget As String
Dim sRow As Long, lr As Long, Col As Long
On Error Resume Next
Set RngToCompare = Application.InputBox(prompt:="Please activate the Source Sheet and select any cell in your source range. In this range you will find the cells wich are not in your range to compare", Type:=8)
On Error GoTo 0
If RngToCompare Is Nothing Then
MsgBox "You didn't select any cell in the Source Range.", vbExclamation
Exit Sub
End If
Set wsSource = RngToCompare.Parent
Col = RngToCompare.Column
If wsSource.Cells(1, Col).Value <> "" Then
sRow = 1
Else
sRow = wsSource.Cells(1, Col).End(xlDown).Row
End If
lr = wsSource.Cells(Rows.Count, Col).End(xlUp).Row
Set RngToCompare = wsSource.Range(wsSource.Cells(sRow + 1, Col), wsSource.Cells(lr, Col))
On Error Resume Next
Set RngToCompareWith = Application.InputBox(prompt:="Please activate the target sheet and select any cell in the Range to compare with.", Type:=8)
On Error GoTo 0
If RngToCompareWith Is Nothing Then
MsgBox "You didn't select any cell in the Range to compare with.", vbExclamation
Exit Sub
End If
Set wsTarget = RngToCompareWith.Parent
Col = RngToCompareWith.Column
If wsTarget.Cells(1, Col).Value <> "" Then
sRow = 1
Else
sRow = wsTarget.Cells(1, Col).End(xlDown).Row
End If
lr = wsTarget.Cells(Rows.Count, Col).End(xlUp).Row
Set RngToCompareWith = wsTarget.Range(wsTarget.Cells(sRow + 1, Col), wsTarget.Cells(lr, Col))
If MsgBox("You are going to compare the range " & RngToCompare.Address(0, 0) & " on " & wsSource.Name & " Sheet with the range " & RngToCompareWith.Address(0, 0) & " on " & wsTarget.Name & " Sheet." & vbNewLine & vbNewLine & _
"Is that correct?", vbQuestion + vbYesNo, "Comfirm Please!") = vbNo Then
MsgBox "You cancelled the range comparison.", vbExclamation, "Range Comparison Cancelled!"
Exit Sub
End If
Application.ScreenUpdating = False
For Each c In RngToCompare
If Not IsError(Application.Match(c, RngToCompareWith, 0)) Then
Intersect(RngToCompare.Cells(1).CurrentRegion, c.EntireRow).Interior.ColorIndex = 4
Else
Intersect(RngToCompare.Cells(1).CurrentRegion, c.EntireRow).Interior.ColorIndex = 3
End If
Next c
wsSource.Sort.SortFields.Clear
wsSource.Sort.SortFields.Add(RngToCompare.Cells(1), _
xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 255, 0)
wsSource.Sort.SortFields.Add(RngToCompare.Cells(1), _
xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 0 _
, 0)
With wsSource.Sort
.SetRange RngToCompare.Cells(1).CurrentRegion
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
End Sub1-Instead of selecting the various range from initial range to end range I would like to select any cell related to the range and display a msgbox confirmation of (Initial Range: End Range)
2-Finish the procedure with a msgbox Your reported range are the following:
Index Range: A2:Axx
Match Range: A2:Axx
Compared Range: A2:Axx
Are you sure that you want to proceed?
If not exit sub
I attached dummy file.
If you have questions, please contact me.
Thank you in advance for your help.
Roy Cox
Can you explain what you want the code to do. 'm sure the code could be more efficient.
ASKER
Perform index match operation in a selected range by selecting the various ranges involved in the operation.
I can see that, but can you attach some dummy date and an idea what you expect the result to be. I can't see an attached file.
ASKER
Sorry, I thought I attached dummy file.
Please find attached dummy file:
Result sheet column B contains expected result.
The idea will be:
1-Simplify vba procedure by including the following:
For the various requested inputbox in which you are requested to select data the idea will be to select the initial range of each of them and read the whole range from initial to the end
Before applying the procedure display an confirm msgbox with the various selected Range:
Example:
Index Range:Sheet A2:Axxx
Compared Range: Sheet A2:Axxx
Match Range: Sheet A2:Axxx
If you have questions, please contact me.
Index-Match.xlsm
Please find attached dummy file:
Result sheet column B contains expected result.
The idea will be:
1-Simplify vba procedure by including the following:
For the various requested inputbox in which you are requested to select data the idea will be to select the initial range of each of them and read the whole range from initial to the end
Before applying the procedure display an confirm msgbox with the various selected Range:
Example:
Index Range:Sheet A2:Axxx
Compared Range: Sheet A2:Axxx
Match Range: Sheet A2:Axxx
If you have questions, please contact me.
Index-Match.xlsm
I don't see the need for parent in this code
It also appears to be giving a row that is not in the data.
I would suggest you try
This should give you the range that you want
Check it out and get back to me. As I said, I'm not entirely sure what you want to do
n1 = target.Parent.UsedRange.Row + target.Parent.UsedRange.Rows.Count - 1It also appears to be giving a row that is not in the data.
I would suggest you try
Set target = Application.InputBox(prompt:="Select index range: ", Title:="Range Select", Type:=8)
''/// the next line is unnecessary
n1 = target.CurrentRegion.Rows.Count
MsgBox (n1)
Set target = target.CurrentRegion.Columns(1)This should give you the range that you want
Set target = target.CurrentRegion.Columns(1)Check it out and get back to me. As I said, I'm not entirely sure what you want to do
Try below and is incorporated in attached...
Sub Improved_Index_Match()
Dim SrcWs As Worksheet, TrgtWs As Worksheet
Dim IndexRng As Range, MatchRng As Range, MatchValue As Range, MatchValRng As Range
Dim iRow As Long, mRow As Long, iiRow As Long, mmRow As Long, iCol As Long, mCol As Long, mvRow As Long, mvCol As Long, mvvRow As Long
On Error Resume Next
Set IndexRng = Application.InputBox(Prompt:="Please select INDEX RANGE, range that you want to lookup in your Source range: ", Title:="Index Range Select", Type:=8)
On Error GoTo 0
If IndexRng Is Nothing Then
MsgBox "You didn't select any cell in the Index Range.", vbExclamation
Exit Sub
End If
Set SrcWs = IndexRng.Parent
iCol = IndexRng.Column
If SrcWs.Cells(1, iCol).Value <> "" Then
iRow = 1
Else
iRow = SrcWs.Cells(1, iCol).End(xlDown).Row
End If
iiRow = SrcWs.Cells(Rows.Count, iCol).End(xlUp).Row
Set IndexRng = SrcWs.Range(SrcWs.Cells(iRow + 1, iCol), SrcWs.Cells(iiRow, iCol))
On Error Resume Next
Set MatchRng = Application.InputBox(Prompt:="Please Select MATCH RANGE which is located in the same sheet of your Source range", Title:="Match Range Select", Type:=8)
On Error GoTo 0
If MatchRng Is Nothing Then
MsgBox "You didn't select any cell in the Match Range to compare with.", vbExclamation
Exit Sub
End If
mCol = MatchRng.Column
If SrcWs.Cells(1, mCol).Value <> "" Then
mRow = 1
Else
mRow = SrcWs.Cells(1, mCol).End(xlDown).Row
End If
mmRow = SrcWs.Cells(Rows.Count, mCol).End(xlUp).Row
Set MatchRng = SrcWs.Range(SrcWs.Cells(mRow + 1, mCol), SrcWs.Cells(mmRow, mCol))
On Error Resume Next
Set MatchValue = Application.InputBox(Prompt:="Please select Matching Values, compared range that you want to lookup in your output range: ", Title:="Matching Values Select", Type:=8)
On Error GoTo 0
If MatchValue Is Nothing Then
MsgBox "You didn't select any cell in the Matching Values Range.", vbExclamation
Exit Sub
End If
Set TrgtWs = MatchValue.Parent
mvCol = MatchValue.Column
If TrgtWs.Cells(1, mvCol).Value <> "" Then
mvRow = 1
Else
mvRow = TrgtWs.Cells(1, mvCol).End(xlDown).Row
End If
mvvRow = TrgtWs.Cells(Rows.Count, mvCol).End(xlUp).Row
Set MatchValRng = TrgtWs.Range(TrgtWs.Cells(mvRow + 1, mvCol), TrgtWs.Cells(mvvRow, mvCol))
If MsgBox("Your reported range are the following:" & vbNewLine & "Index Range:" & IndexRng.Address(0, 0) & vbNewLine & "Match Range:" & MatchRng.Address(0, 0) & vbNewLine & "Matching Values Range:" & MatchValRng.Address(0, 0) & vbNewLine & vbNewLine & _
"Are you sure that you want to proceed?", vbQuestion + vbYesNo, "Comfirm Please!") = vbNo Then
MsgBox "You cancelled the range comparison.", vbExclamation, "Range Comparison Cancelled!"
Exit Sub
End If
Application.ScreenUpdating = False
For Each MatchValue In MatchValRng
If IsNumeric(Application.WorksheetFunction.Match(MatchValue, MatchRng, 0)) Then
MatchValue.Offset(0, 1).Value = Application.WorksheetFunction.Index(IndexRng, Application.WorksheetFunction.Match(MatchValue, MatchRng, 0), 0)
End If
Next MatchValue
MatchValRng.Offset(0, 1).EntireColumn.AutoFit
Application.ScreenUpdating = True
End SubASKER
Thank you for this proposal.
I got an error message with. Could you please help me with this? We also need to add in the last msgbox which report the range the sheets related.
Thank you in advance.
I got an error message with. Could you please help me with this? We also need to add in the last msgbox which report the range the sheets related.
Thank you in advance.
You mean you need Sheet Names as well?
Try below:
Try below:
Sub Improved_Index_Match()
Dim SrcWs As Worksheet, TrgtWs As Worksheet
Dim IndexRng As Range, MatchRng As Range, MatchValue As Range, MatchValRng As Range
Dim iRow As Long, mRow As Long, iiRow As Long, mmRow As Long, iCol As Long, mCol As Long, mvRow As Long, mvCol As Long, mvvRow As Long
On Error Resume Next
Set IndexRng = Application.InputBox(Prompt:="Please select INDEX RANGE, range that you want to lookup in your Source range: ", Title:="Index Range Select", Type:=8)
On Error GoTo 0
If IndexRng Is Nothing Then
MsgBox "You didn't select any cell in the Index Range.", vbExclamation
Exit Sub
End If
Set SrcWs = IndexRng.Parent
iCol = IndexRng.Column
If SrcWs.Cells(1, iCol).Value <> "" Then
iRow = 1
Else
iRow = SrcWs.Cells(1, iCol).End(xlDown).Row
End If
iiRow = SrcWs.Cells(Rows.Count, iCol).End(xlUp).Row
Set IndexRng = SrcWs.Range(SrcWs.Cells(iRow + 1, iCol), SrcWs.Cells(iiRow, iCol))
On Error Resume Next
Set MatchRng = Application.InputBox(Prompt:="Please Select MATCH RANGE which is located in the same sheet of your Source range", Title:="Match Range Select", Type:=8)
On Error GoTo 0
If MatchRng Is Nothing Then
MsgBox "You didn't select any cell in the Match Range to compare with.", vbExclamation
Exit Sub
End If
mCol = MatchRng.Column
If SrcWs.Cells(1, mCol).Value <> "" Then
mRow = 1
Else
mRow = SrcWs.Cells(1, mCol).End(xlDown).Row
End If
mmRow = SrcWs.Cells(Rows.Count, mCol).End(xlUp).Row
Set MatchRng = SrcWs.Range(SrcWs.Cells(mRow + 1, mCol), SrcWs.Cells(mmRow, mCol))
On Error Resume Next
Set MatchValue = Application.InputBox(Prompt:="Please select Matching Values, compared range that you want to lookup in your output range: ", Title:="Matching Values Select", Type:=8)
On Error GoTo 0
If MatchValue Is Nothing Then
MsgBox "You didn't select any cell in the Matching Values Range.", vbExclamation
Exit Sub
End If
Set TrgtWs = MatchValue.Parent
mvCol = MatchValue.Column
If TrgtWs.Cells(1, mvCol).Value <> "" Then
mvRow = 1
Else
mvRow = TrgtWs.Cells(1, mvCol).End(xlDown).Row
End If
mvvRow = TrgtWs.Cells(Rows.Count, mvCol).End(xlUp).Row
Set MatchValRng = TrgtWs.Range(TrgtWs.Cells(mvRow + 1, mvCol), TrgtWs.Cells(mvvRow, mvCol))
If MsgBox("Your reported range are the following:" & vbNewLine & "Index Range: " & SrcWs.Name & " - " & IndexRng.Address(0, 0) & vbNewLine & "Match Range: " & SrcWs.Name & " - " & MatchRng.Address(0, 0) & vbNewLine & "Matching Values Range: " & TrgtWs.Name & " - " & MatchValRng.Address(0, 0) & vbNewLine & vbNewLine & _
"Are you sure that you want to proceed?", vbQuestion + vbYesNo, "Comfirm Please!") = vbNo Then
MsgBox "You cancelled the range comparison.", vbExclamation, "Range Comparison Cancelled!"
Exit Sub
End If
Application.ScreenUpdating = False
For Each MatchValue In MatchValRng
'If IsNumeric(Application.WorksheetFunction.Match(MatchValue, MatchRng, 0)) Then
MatchValue.Offset(0, 1).Value = Application.WorksheetFunction.Index(IndexRng, Application.WorksheetFunction.Match(MatchValue, MatchRng, 0), 0)
'End If
Next MatchValue
MatchValRng.Offset(0, 1).EntireColumn.AutoFit
Application.ScreenUpdating = True
End SubASKER
Yes, name sheet as well. Thank you.
I did included in above code, please try and let me know.
ASKER
Thank you. I tested again and I got an error message.
Based on the following selection:
One remark concerning the sheet display it shows that Index sheet for matching range even if I select related Range (A:A & last used row) which is located in Result sheet
I attached dummy file with last proposal.
Thank you very much for your help.
LD16_Index_Match.xlsm
LD16_Index_Match.xlsm
Based on the following selection:
One remark concerning the sheet display it shows that Index sheet for matching range even if I select related Range (A:A & last used row) which is located in Result sheetI attached dummy file with last proposal.
Thank you very much for your help.
LD16_Index_Match.xlsm
LD16_Index_Match.xlsm
Hope you are not selecting the whole column for Index range or match range or matching values.
For Index range you need to select cell A3 in Index sheet, for Match Range you need to select B3 in Index sheet and for Matching Values you need to select A2 in Result sheet.
I tried in last submitted sheet and it works perfectly.
For Index range you need to select cell A3 in Index sheet, for Match Range you need to select B3 in Index sheet and for Matching Values you need to select A2 in Result sheet.
I tried in last submitted sheet and it works perfectly.
ASKER
Thank you, which Excel version are you using? I am using Excel 2016.
Could you please repost the code that works for you?
Could you please repost the code that works for you?
I am using Excel 2010, but below code should work with Excel 2016.
Sub Improved_Index_Match()
Dim SrcWs As Worksheet, TrgtWs As Worksheet
Dim IndexRng As Range, MatchRng As Range, MatchValue As Range, MatchValRng As Range
Dim iRow As Long, mRow As Long, iiRow As Long, mmRow As Long, iCol As Long, mCol As Long, mvRow As Long, mvCol As Long, mvvRow As Long
On Error Resume Next
Set IndexRng = Application.InputBox(Prompt:="Please select INDEX RANGE, range that you want to lookup in your Source range: ", Title:="Index Range Select", Type:=8)
On Error GoTo 0
If IndexRng Is Nothing Then
MsgBox "You didn't select any cell in the Index Range.", vbExclamation
Exit Sub
End If
Set SrcWs = IndexRng.Parent
iCol = IndexRng.Column
If SrcWs.Cells(1, iCol).Value <> "" Then
iRow = 1
Else
iRow = SrcWs.Cells(1, iCol).End(xlDown).Row
End If
iiRow = SrcWs.Cells(Rows.Count, iCol).End(xlUp).Row
Set IndexRng = SrcWs.Range(SrcWs.Cells(iRow + 1, iCol), SrcWs.Cells(iiRow, iCol))
On Error Resume Next
Set MatchRng = Application.InputBox(Prompt:="Please Select MATCH RANGE which is located in the same sheet of your Source range", Title:="Match Range Select", Type:=8)
On Error GoTo 0
If MatchRng Is Nothing Then
MsgBox "You didn't select any cell in the Match Range to compare with.", vbExclamation
Exit Sub
End If
mCol = MatchRng.Column
If SrcWs.Cells(1, mCol).Value <> "" Then
mRow = 1
Else
mRow = SrcWs.Cells(1, mCol).End(xlDown).Row
End If
mmRow = SrcWs.Cells(Rows.Count, mCol).End(xlUp).Row
Set MatchRng = SrcWs.Range(SrcWs.Cells(mRow + 1, mCol), SrcWs.Cells(mmRow, mCol))
On Error Resume Next
Set MatchValue = Application.InputBox(Prompt:="Please select Matching Values, compared range that you want to lookup in your output range: ", Title:="Matching Values Select", Type:=8)
On Error GoTo 0
If MatchValue Is Nothing Then
MsgBox "You didn't select any cell in the Matching Values Range.", vbExclamation
Exit Sub
End If
Set TrgtWs = MatchValue.Parent
mvCol = MatchValue.Column
If TrgtWs.Cells(1, mvCol).Value <> "" Then
mvRow = 1
Else
mvRow = TrgtWs.Cells(1, mvCol).End(xlDown).Row
End If
mvvRow = TrgtWs.Cells(Rows.Count, mvCol).End(xlUp).Row
Set MatchValRng = TrgtWs.Range(TrgtWs.Cells(mvRow + 1, mvCol), TrgtWs.Cells(mvvRow, mvCol))
If MsgBox("Your reported range are the following:" & vbNewLine & "Index Range: " & SrcWs.Name & " - " & IndexRng.Address(0, 0) & vbNewLine & "Match Range: " & SrcWs.Name & " - " & MatchRng.Address(0, 0) & vbNewLine & "Matching Values Range: " & TrgtWs.Name & " - " & MatchValRng.Address(0, 0) & vbNewLine & vbNewLine & _
"Are you sure that you want to proceed?", vbQuestion + vbYesNo, "Comfirm Please!") = vbNo Then
MsgBox "You cancelled the range comparison.", vbExclamation, "Range Comparison Cancelled!"
Exit Sub
End If
Application.ScreenUpdating = False
For Each MatchValue In MatchValRng
'If IsNumeric(Application.WorksheetFunction.Match(MatchValue, MatchRng, 0)) Then
MatchValue.Offset(0, 1).Value = Application.WorksheetFunction.Index(IndexRng, Application.WorksheetFunction.Match(MatchValue, MatchRng, 0), 0)
'End If
Next MatchValue
MatchValRng.Offset(0, 1).EntireColumn.AutoFit
Application.ScreenUpdating = True
End SubASKER
Thank you. I will test it again soon.
ASKER
Ok, I found where was the problem.
When I switch from Index sheet to Result sheet the selection wasn't taken into account with the sheet name.
I would like to bring last two improvements:
1- If any error code is found instead of launching debug mode exit sub with a proper msgbox "Unable to proceed"
2-Add control for the various inputbox related to the selection in order to make mandatory the sheet name Sheet! following by the range.
Thank you in advance for your help.
When I switch from Index sheet to Result sheet the selection wasn't taken into account with the sheet name.
I would like to bring last two improvements:
1- If any error code is found instead of launching debug mode exit sub with a proper msgbox "Unable to proceed"
2-Add control for the various inputbox related to the selection in order to make mandatory the sheet name Sheet! following by the range.
Thank you in advance for your help.
ASKER
The R1C1 notation doesn't work the same based on excel version.
I would like to share a comment based on another question in which the selection control has been added:
https://www.experts-exchan
Could you please someone help me with this control?
Thank you in advance for your help.
I would like to share a comment based on another question in which the selection control has been added:
https://www.experts-exchan
Could you please someone help me with this control?
Thank you in advance for your help.
Ok check in attached. I have included the sheet name in the header of Input Box as well.
LD16_Index_Match_v2.xlsm
LD16_Index_Match_v2.xlsm
ASKER
Thank you Shums for this update.
The file attached don't have last loop version:
Could you please update the file so I can assign your comment as final solution?
Thank you in advance for your help.
The file attached don't have last loop version:
For Each MatchValue In MatchValRng
'If IsNumeric(Application.WorksheetFunction.Match(MatchValue, MatchRng, 0)) Then
MatchValue.Offset(0, 1).Value = Application.WorksheetFunction.Index(IndexRng, Application.WorksheetFunction.Match(MatchValue, MatchRng, 0), 0)
'End If
Next MatchValueCould you please update the file so I can assign your comment as final solution?
Thank you in advance for your help.
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.
I will test it today.
Thank you again for your help.
I will test it today.
Thank you again for your help.
ASKER
Sorry for the delay.
I retested and it works!
Just one comment I add some msgbox in order to clarify and don't forget how to select the various inputboxs.
And I retake the isnumeric formula just in case we have just numeric values.
Thank you again for your help.
LD16_Index_Match_Final.xlsm
I retested and it works!
Just one comment I add some msgbox in order to clarify and don't forget how to select the various inputboxs.
And I retake the isnumeric formula just in case we have just numeric values.
Thank you again for your help.
LD16_Index_Match_Final.xlsm
You are welcome. Glad I was able to help.