Macro for lookup

Hello,

can someone help me with a macro instead of the Vlookup formula
in the attachment you can find the example excel file

In column A we have a lot of values, these are the look up values.
In column D2:BL66 is the table array.
The values from column A may occur in D2:BL66 (not all in this example), should be linked to the values in column BN

thanks

Hi WillemB,
maybe so

Sub ertert()
Dim x, i&, r As Range
x = Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value
With Range("D1:BN" & Cells(Rows.Count, 4).End(xlUp).Row)
    For i = 1 To UBound(x)
        Set r = .Find(x(i, 1), lookat:=xlWhole)
        If r Is Nothing Then x(i, 1) = vbNullString Else x(i, 1) = .Cells(r.Row, .Columns.Count)
    Next i
End With
Range("B2").Resize(i - 1).Value = x
End Sub

as an option

Sub ertert22()
'Dim tm!: tm = Timer
Dim x, i&, j&, ubx&
x = Range("D1:BN" & Cells(Rows.Count, 4).End(xlUp).Row).Value
ubx = UBound(x, 2)
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(x)
        For j = 1 To ubx
            If Len(x(i, j)) Then .Item(x(i, j)) = x(i, ubx)
        Next j
    Next i
    x = Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value
    For i = 1 To UBound(x)
        If Not .Exists(x(i, 1)) Then x(i, 1) = "" Else x(i, 1) = .Item(x(i, 1))
    Next i
End With
Range("B2").Resize(i - 1).Value = x
'MsgBox Timer - tm
End Sub

Thanks Nilem,

Is it also possible if the value in column BN is a text like (example FRGTESAF

Nilem,

short question,
is it possible to run the macro on an other sheet than where the table array is?

Hoi Nilem,

Just run your second macro, it works great!

Thanks!!

something like this

Sub ertert33()
Dim x, i&, j&, ubx&
With Sheets("Sheet2")
    x = .Range("D1:BN" & .Cells(Rows.Count, 4).End(xlUp).Row).Value
End With
ubx = UBound(x, 2)
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(x)
        For j = 1 To ubx
            If Len(x(i, j)) Then .Item(x(i, j)) = x(i, ubx)
        Next j
    Next i
    With Sheets("Sheet1")
        x = .Range("A2", .Cells(Rows.Count, 1).End(xlUp)).Value
    End With
    For i = 1 To UBound(x)
        If Not .Exists(x(i, 1)) Then x(i, 1) = "" Else x(i, 1) = .Item(x(i, 1))
    Next i
End With
Sheets("Sheet1").Range("B2").Resize(i - 1).Value = x
End Sub

I did, but nothing happens,

just have the table array on sheet 1
and the look up on sheet 2 column B
have to fill in the linked value to sheet 2 column D

Can you attach an example of your file?

here the exampl2

try

Sub ertert44()
Dim x, i&, j&, ubx&
With Sheets("Sheet2")
    x = .Range("A1:BK" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
End With
ubx = UBound(x, 2)
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(x)
        For j = 1 To ubx
            If Len(x(i, j)) Then .Item(x(i, j)) = x(i, ubx)
        Next j
    Next i
    With Sheets("Sheet1")
        x = .Range("B4", .Cells(Rows.Count, 2).End(xlUp)).Value
    End With
    For i = 1 To UBound(x)
        If Not .Exists(x(i, 1)) Then x(i, 1) = "" Else x(i, 1) = .Item(x(i, 1))
    Next i
End With
Sheets("Sheet1").Range("D4").Resize(i - 1).Value = x
End Sub

Hoi Nilem,
It's working Thanks!!