-
Vlookup Multiple Values By Adding Formula With Loop In VBA
-
So what is it that you want? Do you want to loop through a column and return the values from an adjacent column, and give the values from there when the value in the first column matches the value you are looking up?
-
Quote:
Originally Posted by
Excel Fox
So what is it that you want? Do you want to loop through a column and return the values from an adjacent column, and give the values from there when the value in the first column matches the value you are looking up?
You are right I want it to return as normal vlookup do. Like if the lookup value is repeated in a column, it want it to return every result.
-
Can be done. Can you post a sample file and show the expected output also.
-
1 Attachment(s)
I have attatched the file. Can you please write a vba and formula, if any, for the task?
Regards,
Safal
-
Try this formula:
Copy below formula and apply it with CSE and drag it down:
=IFERROR(INDEX(thingstodo,SMALL(IFERROR(IF((things todo[Date]=$D$11),ROW($A$1:$A$100),""),""),ROW($A1)),2),"")
-
I can't drag it down. I need it to be automatical. So I was asking for the loop.
Regards,
Safal
-
Then it can be done with the help of VBA Macro. Is it Ok?
-
Ok. Thanks
Regards,
Safal
-
Try this:
Code:
Sub LMP_Test()
Dim rngData As Range
Dim rngFirstValue As Range
Dim rngValue As Range
Dim varResult() As Variant
Dim strFindWhat As String
Dim lngCount As Long
Const strShtName As String = "calcs"
Const strDataStartCell As String = "C4"
Const strCriteriaCell As String = "D11"
Const strResultCell As String = "C15"
Const strBlankArrayVal As String = "ArrayIsBlankWithNoDataFound"
With Worksheets(strShtName)
Set rngData = .Range(strDataStartCell).CurrentRegion
strFindWhat = .Range(strCriteriaCell).Value
With rngData.Resize(, 1)
Set rngValue = .Find(strFindWhat, LookIn:=xlValues)
If Not rngValue Is Nothing Then
Set rngFirstValue = rngValue
Set rngValue = Nothing
lngCount = 1
ReDim varResult(1 To lngCount)
varResult(LBound(varResult)) = strBlankArrayVal
Do
If rngValue Is Nothing Then
Set rngValue = .FindNext(rngFirstValue)
varResult(lngCount) = rngValue.Offset(, 1).Value
Else
lngCount = lngCount + 1
Set rngValue = .FindNext(rngValue)
ReDim Preserve varResult(1 To lngCount)
varResult(lngCount) = rngValue.Offset(, 1).Value
End If
Loop While Not rngValue Is Nothing And rngValue.Address <> rngFirstValue.Address
End If
End With
If varResult(LBound(varResult)) <> strBlankArrayVal Then
.Range(strResultCell).Resize(10000).ClearContents
varResult = Application.Transpose(varResult)
.Range(strResultCell).Resize(UBound(varResult), 1).Value = varResult
End If
End With
Set rngData = Nothing
Set rngFirstValue = Nothing
Set rngValue = Nothing
Erase varResult
strFindWhat = vbNullString
lngCount = Empty
End Sub
:cheers:
-
Is the code working with the sheet I have attached? Because it is showing Run time 9 error. Or do I have to change anything in the code?
Thanx
-
It is working fine as i already tested it with your attached file.
There are some constants there you can change it if required.
-
Can you please attach the workbook you worked on? Thanks.
-
I tested it again on your attached file and it is working fine. Restart your system and then check it again may be it will work.
-
Sorry for the trouble but again 'subscript out of range'.
-
The problem was with the strfindwhat data type. I should have been date datatype. Anyways thanks.
