Vlookup Multiple Values By Adding Formula With Loop In VBA

**Safal Shrestha** · 04-16-2013, 03:31 PM

**Excel Fox** · 04-16-2013, 10:18 PM

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** · 04-17-2013, 10:25 AM

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.

**Excel Fox** · 04-17-2013, 11:00 PM

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

**Safal Shrestha** · 04-18-2013, 10:53 AM

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

Regards,
Safal

**LalitPandey87** · 04-18-2013, 12:10 PM

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** · 04-18-2013, 12:13 PM

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

Regards,
Safal

**LalitPandey87** · 04-18-2013, 12:50 PM

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

**Safal Shrestha** · 04-18-2013, 01:40 PM

Ok. Thanks

Regards,
Safal

**LalitPandey87** · 04-18-2013, 01:47 PM

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