Alternative to Vlookup in VBA?

Question

A strange question perhaps, but is there an alternative way of opening a workbook, searching for a particular reference in a column, and then pulling the data from a another column in that row using VBA, without using VLookup?

The table I am trying to get data from contains a mixture of numbers, text, dates, and the lookup value is often >13 digits long.

I sort of had something working with VLookup, but it was too inconsistent - every so often it would just break because the data type didn't match. An awful lot of 'type mismatch' or 'ByRef' errors - I'd get one right and then another breaks.

Unfortunately I don't know enough to know what to search to get me in the right direction.

If it helps explain what I'm trying to do, here's my code using VLookup that errors all the time:

Sub getData()

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual

Dim wb As Workbook, src As Workbook
Dim srcRange As Range
Dim InputString
Dim strStatus
Dim strStatusNum
Dim strD1
Dim I As Integer

Set wb = ActiveWorkbook

I = 7

Set src = Workbooks.Open("D:\Files\test2.xlsx", True, True)
    With src.Sheets(1)
        Set srcRange = .Range(.Range("A1"), .Range("H1").End(xlDown))
End With

Do While wb.ActiveSheet.Cells(I, 1) <> ""

    'Makes sure src.Close is called if errors
    'On Error Resume Next

    InputString = wb.Worksheets("Sheet 1").Cells(I, 1)

    strStatus = Application.VLookup(InputString, srcRange, 3, False)

    strD1 = Application.VLookup(InputString, srcRange, 4, False)

    'Convert strStatus to actual number e.g. "03. no d1"
    strStatusNum = Left(strStatus, 2)

    wb.Worksheets("Sheet 1").Cells(I, 4) = strStatusNum

        If (strStatusNum <> 3) Then

            wb.Worksheets("Sheet 1").Cells(I, 2) = "Not at 03. No Work Order"

        ElseIf (strStatusNum = 3) And (strD1 <> "") Then

            wb.Worksheets("Sheet 1").Cells(I, 2) = "D1 Received"
            wb.Worksheets("Sheet 1").Cells(I, 3) = strD1

        Else

            wb.Worksheets("Sheet 1").Cells(I, 2) = "No D1"

        End If

    I = I + 1

Loop


src.Close (False)

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic

End Sub

EDIT: Corrected some syntax.

Answer 1

You can use the Find method of the Range object, in your case of the column. The return value is the first cell (represented as another Range object) with a matching value, unless there is no match at all. Then Nothing is returned.

On the returned (single cell) range you can use the EntireRow method to get a Range that represents all the cells on the row of the found cell. On the returned (row) range you can use the Cells method to select the cell matching the column in the same row, that you want to return (again represented as another Range object).

By the way, a more flexible alternative to VLOOKUP in workbook functions is a combination of INDEX and MATCH.

Answer 2

you may be after this refactoring of your code

Sub getData() 
    Dim wbRng As Range, cell As Range, f As Range
    Dim strStatus, strStatusNum, strD1 

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlManual


    With ActiveWorkbook.ActiveSheet
        Set wbRng = .Range("A7:A" & WorksheetFunction.Max(7, .Cells(.Rows.count, 1).End(xlUp).Row)) '<--| set the range of values to be searched for
        If WorksheetFunction.CountA(wbRng) = 0 Then Exit Sub '<--| exit if no values under row 7
        Set wbRng = wbRng.SpecialCells(xlCellTypeConstants)  '<--| narrow the range of values to be searched for down to not blank values only
    End With

    With Workbooks.Open("D:\Files\test2.xlsx", True, True).Sheets(1) '<--| open wanted workbook and reference its first sheet
        With .Range("A1:A" & .Cells(.Rows.count, "H").End(xlUp).Row) '<--| reference its column A range from row 1 down to column H last not empty cell (this is your former "srcRange")
            For Each cell In wbRng.SpecialCells(xlCellTypeConstants) '<--| loop through range of values to be searched for
                Set f = .Find(what:=cell.Value, lookat:=xlWhole, LookIn:=xlValues) '<--| look referenced range for current value to be searched for
                If Not f Is Nothing Then '<--| if found
                    strStatus = f.Offset(, 2).Value
                    strD1 = f.Offset(, 3).Value

                    'Convert strStatus to actual number e.g. "03. no d1"
                    strStatusNum = val(Left(strStatus, 2)) '<--| use 'Val()' function to convert string "03" to "3"
                    cell.Offset(, 3) = strStatusNum
                    Select Case True
                        Case strStatusNum <> 3
                            cell.Offset(, 1).Value = "Not at 03. No Work Order"
                        Case strStatusNum = 3 And (strD1 <> "")
                            cell.Offset(, 1).Resize(, 2).Value = Array("D1 Received", strD1)
                        Case Else
                            cell.Offset(, 1).Value = "No D1"
                    End Select
                End If
            Next
        End With
        .Parent.Close False
    End With

    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Calculation = xlAutomatic

End Sub

Answer 3

Untested but compiled:

Sub getData()

    Dim src As Workbook
    Dim srcRange As Range
    Dim strStatus, strStatusNum, strD1
    Dim m, rw As Range

    Set rw = ActiveSheet.Rows(7)

    Set src = Workbooks.Open("D:\Files\test2.xlsx", True, True)
    With src.Sheets(1)
        Set srcRange = .Range(.Range("A1"), .Range("H1").End(xlDown))
    End With

    Do While rw.Cells(1).Value <> ""

        m = Application.Match(rw.Cells(1), srcRange.Columns(1), 0)

        If Not IsError(m) Then 'proceed only if got match

            strStatus = srcRange.Cells(m, 3).Value
            strD1 = srcRange.Cells(m, 4).Value
            strStatusNum = Left(strStatus, 2)

            rw.Cells(4).Value = strStatusNum

            If strStatusNum <> 3 Then
                rw.Cells(2) = "Not at 03. No Work Order"
            ElseIf strStatusNum = 3 And strD1 <> "" Then
                rw.Cells(2) = "D1 Received"
                rw.Cells(3) = strD1
            Else
                rw.Cells(2) = "No D1"
            End If

        End If

        Set rw = rw.Offset(1, 0)

    Loop

    src.Close False

End Sub