Vlookup Multiple Values By Adding Formula With Loop In VBA

[Safal Shrestha]

While using vlookup in my Vba, I got stuck because every time the loop circulates it returns the same result from the table array whether it is the first one or the last one. I am using a table as a table array.

Can anybody suggest me a solution to the problem?

Regards,
Safal


https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h78GftO_ iE (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h78GftO_ iE)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h77HSGDH 4A (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h77HSGDH 4A)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h76fafzc EJ (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h76fafzc EJ)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h759YIjl aG (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h759YIjl aG)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h74pjGcb Eq (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h74pjGcb Eq)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgzJJUDVv2Mb6YGkPYh4AaABAg.9h5uPRbWIZl9h7165DZd jg (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgzJJUDVv2Mb6YGkPYh4AaABAg.9h5uPRbWIZl9h7165DZd jg)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[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?

[Safal Shrestha]

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.

[Excel Fox]

Can be done. Can you post a sample file and show the expected output also.

[Safal Shrestha]

I have attatched the file. Can you please write a vba and formula, if any, for the task?

Regards,
Safal

[LalitPandey87]

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),"")

[Safal Shrestha]

I can't drag it down. I need it to be automatical. So I was asking for the loop.

Regards,
Safal

[LalitPandey87]

Then it can be done with the help of VBA Macro. Is it Ok?

[Safal Shrestha]

Ok. Thanks

Regards,
Safal

[LalitPandey87]

Try this:



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:

[Safal Shrestha]

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

[LalitPandey87]

It is working fine as i already tested it with your attached file.
There are some constants there you can change it if required.

[Safal Shrestha]

Can you please attach the workbook you worked on? Thanks.

[LalitPandey87]

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.

[Safal Shrestha]

Sorry for the trouble but again 'subscript out of range'.

[Safal Shrestha]

The problem was with the strfindwhat data type. I should have been date datatype. Anyways thanks.