Vlookup and Replace if match found VBA

[Lola223]

Hi All,

I have never used the vlookup function using VBA and I am looking for a bit of assistance.

I have 2 worksheets within my workbook named:
LookupValues
DatatoLookup

In the first Sheet named LookupValues I have the following:
JobRef Description
A1234 Replacment Des 1
B2345 Replacment Des 2

In the second sheet named DatatoLookup I have the following:
JobRef Description
A1234 Description a
B2345 Description b
C1234 Description c
D4567 Description d
A1234 Desription a

What I want to do is each month the JobRefs in LookupValues can change or may be blank = the user will input the value in the cells. I want to capture the values in these cells and look them up on the DatatoLookup worksheet for the specified range (the range could vary each month so I would need to ensure I am searching down to the last row of data)

If a match is found for the JobRef, I'd like to replace the Description held in the DatatoLookup against that JobRef with the value held in the corresponding cell in the Description filed within the LookupValues

I attemped to make a start on the code but didn't get too far. Here's what I have so far:

Sub UpdateValues()
Dim Bi_JobNo As String
Dim Quart_JobNo As String

Bi_JobNo = Range("A2").Value
Quart_JobNo = Range("A3").Value

Application.WorksheetFunction.VLookup(Bi_JobNo,DatatoLookup.Range(A2:B5),2, False)
Application.WorksheetFunction.VLookup(Quart_JobNo,DatatoLookup.Range(A2:B5),2, False)

 

[mumps]

Hopefully, I understood correctly. Try:

Sub CompareData()
    Application.ScreenUpdating = False
    Dim i As Long, srcWS As Worksheet, desWS As Worksheet, v1 As Variant, v2 As Variant, arr() As Variant, dic As Object, cnt As Long: cnt = 0
    Set srcWS = Sheets("LookupValues")
    Set desWS = Sheets("DatatoLookup ")
    v1 = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
    v2 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v1) To UBound(v1)
        If Not dic.exists(v1(i, 1)) Then
            dic.Add v1(i, 1), v1(i, 2)
        End If
    Next i
    For i = LBound(v2) To UBound(v2)
        If dic.exists(v2(i, 1)) Then
            desWS.Range("B" & i + 1) = dic(v2(i, 1))
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[Lola223]

Hi All,

I have never used the vlookup function using VBA and I am looking for a bit of assistance.

I have 2 worksheets within my workbook named:
LookupValues
DatatoLookup

In the first Sheet named LookupValues I have the following:
JobRef Description
A1234 Replacment Des 1
B2345 Replacment Des 2

In the second sheet named DatatoLookup I have the following:
JobRef Description
A1234 Description a
B2345 Description b
C1234 Description c
D4567 Description d
A1234 Desription a

What I want to do is each month the JobRefs in LookupValues can change or may be blank = the user will input the value in the cells. I want to capture the values in these cells and look them up on the DatatoLookup worksheet for the specified range (the range could vary each month so I would need to ensure I am searching down to the last row of data)

If a match is found for the JobRef, I'd like to replace the Description held in the DatatoLookup against that JobRef with the value held in the corresponding cell in the Description filed within the LookupValues

I attemped to make a start on the code but didn't get too far. Here's what I have so far:

Sub UpdateValues()
Dim Bi_JobNo As String
Dim Quart_JobNo As String

Bi_JobNo = Range("A2").Value
Quart_JobNo = Range("A3").Value

Application.WorksheetFunction.VLookup(Bi_JobNo,DatatoLookup.Range(A2:B5),2, False)
Application.WorksheetFunction.VLookup(Quart_JobNo,DatatoLookup.Range(A2:B5),2, False)

Thank you for your response, that was exactly what I was after. I appreciate you taking the time to help me.

 

[Lola223]

Hopefully, I understood correctly. Try:

Sub CompareData()
    Application.ScreenUpdating = False
    Dim i As Long, srcWS As Worksheet, desWS As Worksheet, v1 As Variant, v2 As Variant, arr() As Variant, dic As Object, cnt As Long: cnt = 0
    Set srcWS = Sheets("LookupValues")
    Set desWS = Sheets("DatatoLookup ")
    v1 = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
    v2 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v1) To UBound(v1)
        If Not dic.exists(v1(i, 1)) Then
            dic.Add v1(i, 1), v1(i, 2)
        End If
    Next i
    For i = LBound(v2) To UBound(v2)
        If dic.exists(v2(i, 1)) Then
            desWS.Range("B" & i + 1) = dic(v2(i, 1))
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Thank you for your response, that was exactly what I was after. I appreciate you taking the time to help me.

 

[mumps]

You are very welcome.

 

[Lola223]

Hi All,

This has been working very well for me for the past few months, however there is now another worksheet that I want to lookup and replace the values.

I replicated the code above, my source worksheet is the same and destination worksheet different. It works but the code takes approx 5mins to run and I wanted to speed it up.

Rather than repeating the code above twice which has the same source worksheet and two different destination worksheets looking up the same values to replace, is there a more efficient way I can add this into the existing code above?

Thank you

 

[Alex Blakenburg]

See if this helps. It is a modification of what @mumps provided.
It should be faster.

Note:
I took the space at the end, out of the sheet name "DatatoLookup "
I called the 2nd destination sheet "DatatoLookup2" - Change this to what you need it to be.

Sub CompareData_mumps_mod()
    Application.ScreenUpdating = False
    Dim i As Long, srcWS As Worksheet, destWS1 As Worksheet, destWS2 As Worksheet
    Dim rngDest1 As Range, rngDest2 As Range
    Dim arrSrc As Variant, arrDest1 As Variant, arrDest2 As Variant
    Dim dic As Object, cnt As Long: cnt = 0
    
    Set srcWS = Sheets("LookupValues")
    Set destWS1 = Sheets("DatatoLookup")
    Set destWS2 = Sheets("DatatoLookup2")       '<--- Additional destination - change name as required
    
    arrSrc = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
    
    Set rngDest1 = destWS1.Range("A2", destWS1.Range("A" & Rows.Count).End(xlUp)).Resize(, 2)
    arrDest1 = rngDest1.Value
    
    Set rngDest2 = destWS2.Range("A2", destWS2.Range("A" & Rows.Count).End(xlUp)).Resize(, 2)
    arrDest2 = rngDest2.Value
    
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(arrSrc) To UBound(arrSrc)
        If Not dic.exists(arrSrc(i, 1)) Then
            dic.Add arrSrc(i, 1), arrSrc(i, 2)
        End If
    Next i
    
    ' 1st Destination
    For i = LBound(arrDest1) To UBound(arrDest1)
        If dic.exists(arrDest1(i, 1)) Then
            arrDest1(i, 2) = dic(arrDest1(i, 1))
        End If
    Next i
    rngDest1.Value = Application.Index(arrDest1, 0, 2)
    
    ' 2nd Destination
    For i = LBound(arrDest2) To UBound(arrDest2)
        If dic.exists(arrDest2(i, 1)) Then
            arrDest2(i, 2) = dic(arrDest2(i, 1))
        End If
    Next i
    rngDest2.Value = Application.Index(arrDest2, 0, 2)
    
    Application.ScreenUpdating = True
End Sub