Home > Back-end >  How to pull data from another sheet in a user defined VBA function
How to pull data from another sheet in a user defined VBA function

Time:03-01

I created a function for a colleague which works like an xLookUp but allows the user to return the N from last match found. To get the function to work I had to add an argument for the user to enter the Worksheet.Name. Without this argument, I could not get the function to return values from the proper sheet if the lookup_sheet was not the sheet the function was entered on. I understand the Application.Caller method can be used to make sure the code is looking at the sheet the function is entered on, but how do I have it look at the sheet the range argument is set to?

My function, entered on a worksheet called "Supplies_List" reads as =xLookUp_X_From_Last (D2,"Orders",Orders!E:E,Orders!I:I,"",2) and the code is:

Public Function xLookUp_X_From_Last(ByVal LookUp_Value As String, ByVal LookUp_Sheet As String, ByVal LookUp_Column As Range, ByVal Return_Column As Range, ifNA As String, Return_From_Last As Long) As String
    
    Dim myCol As Collection
    Dim i, LR, colCount, lColumn, rColumn, lookBack As Long
    Dim lLetter, cLetter, s As String
    Dim lSheet As Worksheet
    Dim wb As Workbook
    
    Set wb = ActiveWorkbook
    Set lSheet = wb.Worksheets(LookUp_Sheet)
    
    lookBack = Return_From_Last - 1
    
    If LookUp_Column.Columns.Count <> 1 Or Return_Column.Columns.Count <> 1 Then
        xLookUp_X_From_Last = "SELECTED RANGE ERROR"
        Exit Function
    End If
    If LookUp_Value = "" Then
        xLookUp_X_From_Last = ifNA
        Exit Function
    End If
    
    Set myCol = New Collection
    
    lColumn = LookUp_Column.Column
    rColumn = Return_Column.Column
    lLetter = Split(Cells(1, lColumn).Address, "$")(1)
    
    LR = lSheet.Range(lLetter & Rows.Count).End(xlUp).Row
    
    For i = 1 To LR
        If lSheet.Cells(i, lColumn).Value = LookUp_Value Then
            myCol.Add lSheet.Cells(i, rColumn).Value
        End If
    Next i

    colCount = myCol.Count
    
    If (colCount - lookBack) < 1 Then
        s = ifNA
    Else
        s = myCol(colCount - (lookBack))
    End If
    
    xLookUp_X_From_Last = s

End Function

Even though the LookUp_Column argument references the sheet with Orders!E:E, I had to add the LookUp_Sheet argument. I'm pretty good at Subroutines, but not very good at functions and this has stumped me.

I searched high and low to find the VBA code for vLookUp and xLookUp to dissect and learn from, but could not find it. If anyone can point me to the source code for those functions that would be awesome as well.

CodePudding user response:

(a) As mentioned in the comments, you can get the worksheet of a range by it's Parent-Property
(b) It is almost never neccessary to deal with column characters in VBA.
(c) Be careful with your variable declaration. If you want to declare multiple variables in one line, you need to specify the type for each of them, else only the last variable if of the type you specify, all the others are declared as Variant. See for example https://stackoverflow.com/a/71250993/7599798
(d) There is nearly no difference between Subroutines and Functions, except that a function returns a value. If you want to use the function as UDF, you have some (obvious) limitations, eg don't modify the underlying excel, don't use Select and Activate - but you shouldn't use that in VBA anyhow.

Have a look to the function below. For speed reasons, I read the lookup and return range into an array, especially for UDFs speed matters and this reduces the amount of round-trips between Excel and VBA. I also made the last 2 parameters optional.

Public Function xLookUp_X_From_Last(ByVal LookUp_Value As String, _
          ByVal LookUp_Column As Range, ByVal Return_Column As Range, _
          Optional ifNA As String = "not found", _
          Optional Return_From_Last As Long = 1) As String
    
    Dim myCol As Collection
    Dim i As Long, LR As Long, lookBack As Long
    
    lookBack = Return_From_Last - 1
    If LookUp_Column.Columns.Count <> 1 Or Return_Column.Columns.Count <> 1 Then
        xLookUp_X_From_Last = "SELECTED RANGE ERROR"
        Exit Function
    End If
    
    If LookUp_Value = "" Then
        xLookUp_X_From_Last = ifNA
        Exit Function
    End If
    
    Set myCol = New Collection
    
    Dim lookupValues As Variant, returnValues As Variant
    With LookUp_Column.Parent
        LR = .Cells(.Rows.Count, LookUp_Column.Column).End(xlUp).Row
        lookupValues = LookUp_Column.Cells(1, 1).Resize(LR, 1)
        returnValues = Return_Column.Cells(1, 1).Resize(LR, 1)
    End With

    For i = LBound(lookupValues) To UBound(lookupValues)
        If lookupValues(i, 1) = LookUp_Value Then
            myCol.Add CStr(returnValues(i, 1)), CStr(i)
        End If
    Next i

    If (myCol.Count - lookBack) < 1 Then
        xLookUp_X_From_Last = ifNA
    Else
        xLookUp_X_From_Last = myCol(myCol.Count - lookBack)
    End If
End Function
  • Related