Use Native Excel Function Lookup Formula In VBA

[LalitPandey87]

Here is a code which do not use worksheet functions but do the same work:

Option Explicit


Sub LMP_Test()


    Dim rngRange                As Range
    Dim varArrData()            As Variant
    Dim varArrDataFinal()       As Variant
    Dim lngCount                As Long
    Dim lngLoop                 As Long
    
    Const strDataSheetName      As String = "Sheet1" 'Change accordingly
    Const strDataCell           As String = "A1" 'Change accordingly
    Const strDataResultCell     As String = "B1" 'Change accordingly
    
    With ThisWorkbook.Worksheets(strDataSheetName)
        Set rngRange = .Range(strDataCell)
        Set rngRange = .Range(rngRange, .Cells(.Rows.Count, rngRange.Column).End(xlUp))
        If rngRange.Rows.Count > 1 Then
            varArrData = rngRange.Value
        Else
            ReDim varArrData(1 To 1, 1 To 1)
            varArrData(1, 1) = rngRange.Value
        End If
        Set rngRange = .Range(strDataResultCell)
        lngCount = 0
        rngRange.EntireColumn.ClearContents
        For lngLoop = LBound(varArrData) To UBound(varArrData)
            If Len(Trim(varArrData(lngLoop, 1))) > 0 Then
                rngRange.Offset(lngCount).Value = varArrData(lngLoop, 1)
                lngCount = lngCount + 1
            End If
        Next lngLoop
    End With
    Set rngRange = Nothing
    Erase varArrData
    Erase varArrDataFinal
    lngCount = Empty
    lngLoop = Empty
    
End Sub