Vba code for lookup if the value exists

[VbaHell]

Hello all

I need an excel guru to solve this one please

I have multiple lookup's against a primary key in two work tabs

This then brings through the data I need

The problem I have is if the source line no longer exist the lookup will wipe out the last data that was in the cell..

I need something like if the primary key is not there stop the vlookup and leave the content in the cell, if the primary key exists then complete the lookup and over write the cell with the new data.

With Range("F1:F" & LastRow)
        .FormulaR1C1 = "=VLOOKUP(RC[-5],Data!C[-5]:C[15],21,FALSE)"
        .Value = .Value
        .Replace "#N/A", "", xlWhole
    End With

 

[JackDanIce]

Try:

Sub M1()
    
    Dim x       As Long
    Dim dic     As Object
    Dim arr()   As Variant
    
    Application.ScreenUpdating = False
    
    With sheets("Data")
        arr = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 21).Value
    End With
    
    For x = LBound(arr, 1) To UBound(arr, 1)
        dic(arr(x, 1)) = arr(x, 21)
    Next x
    
    With ActiveSheet
        arr = .Cells(1, 6).Resize(.Cells(.Rows.Count, 6).End(xlUp).Row).Value
        For x = LBound(arr, 1) To UBound(arr, 1)
            If dic.exists(arr(x, 1)) Then arr(x, 1) = dic(arr(x, 1))
        Next x
        
        .Cells(1, 6).Resize(UBound(arr, 1)).Value = arr
    End With
    
    Application.ScreenUpdating = True


End Sub

 

[VbaHell]

Hi JackDanIce

thank you for your reply

I ran your code but it's bugging out on this line

dic(arr(x, 1)) = arr(x, 21)

Run time error "Object Variable or With Block Variable not set"

If I debug and hover over "dic" then I get

[LEFT][COLOR=#222222][FONT=Tahoma]dic(arr(x, 1)) = [COLOR=#333333][FONT=Verdana]Object Variable or With Block Variable not set[/FONT][/COLOR][/FONT][/COLOR][/LEFT]

 

[JackDanIce]

Try:

Sub M1()
    
    Dim x       As Long
    Dim dic     As Object: Set dic = CreateObject("Scripting.Dictionary")
    Dim arr()   As Variant
    
    Application.ScreenUpdating = False
    
    With sheets("Data")
        arr = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 21).Value
    End With
    
    For x = LBound(arr, 1) To UBound(arr, 1)
        dic(arr(x, 1)) = arr(x, 21)
    Next x
    
    With ActiveSheet
        arr = .Cells(1, 6).Resize(.Cells(.Rows.Count, 6).End(xlUp).Row).Value
        For x = LBound(arr, 1) To UBound(arr, 1)
            If dic.exists(arr(x, 1)) Then arr(x, 1) = dic(arr(x, 1))
        Next x
        
        .Cells(1, 6).Resize(UBound(arr, 1)).Value = arr
    End With
    
    Application.ScreenUpdating = True


    Set dic = Nothing
    Erase arr
    
End Sub

 

[VbaHell]

Sorry to be a pain, the code runs now so I change the value in the "data" sheet on column 21 to see if the correct data would populate the activesheet with the same key in column 6 but it stays the same.

 

[Fluff]

Try this change

        arr = .Cells(1, [COLOR=#ff0000]1[/COLOR]).Resize(.Cells(.Rows.Count, [COLOR=#ff0000]1[/COLOR]).End(xlUp).Row).Value

 

[VbaHell]

Hi Fluff

This is nearly correct, if the key in the active sheet column 1 exist in "Data" column 1 then it now puts this value into active sheet column 6 which is what I want
But if the key in the active sheet sheet column 1 does not exist in the "data" column1 then the active sheet has the column1 value entered into column 6 which overright the last value which I don't want

 

[Fluff]

Try

    With ActiveSheet
        arr = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 6).Value
        For x = LBound(arr, 1) To UBound(arr, 1)
            If dic.exists(arr(x, 1)) Then arr(x, 6) = dic(arr(x, 1))
        Next x
        
        .Cells(1, 6).Resize(UBound(arr)).Value = Application.Index(arr, 0, 6)
    End With

 

[VbaHell]

That's it, spot on, thanks very much to both of you for helping me with this

 

[Fluff]

Glad we could help & thanks for the feedback