VBA Lookup Values in Another Workbook

[unknownymous]

Hi Guys,

I have 2 workbooks on my deck namely Project (source file) and Reference (vlookup reference file).

In Project workbook, I need to look for the Value of F in Reference Sheet column B and populate it in G column.

Project Workbook: I was able to populate the data in column G using below codes but I also need to get other values for Column H:J. Also, badly need to adjust the formula based on the last non-blank cell and hardcode the formula.

Value for Column G = Column C in Reference File
Value for Column H = Column D in Reference File
Value for Column I = Column E in Reference File
Value for Column J = Column F in Reference File

-------------------------------------------------------------------------------
Sub ProjectLookUp()
Dim rw As Long, x As Range
Dim extwbk As Workbook, twb As Workbook


Set twb = ThisWorkbook
Set extwbk = Workbooks.Open("C:\Users\unknown\Documents\Reference.xlsx")
Set x = extwbk.Worksheets("Sheet1").Range("B1:I100000")


With twb.Sheets("Final")


For rw = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(rw, 7) = Application.VLookup(.Cells(rw, 6).Value2, x, 2, False)
Next rw


End With


extwbk.Close savechanges:=False
End Sub

-------------------------------------------------------------------------------

Any help will be much appreciated.

 

[Fluff]

How about

Sub unkownymous()
   Dim Cl As Range
   Dim Wbk As Workbook
   Dim ExWs As Worksheet, Tws As Worksheet
   
   Set Tws = ThisWorkbook.Sheets("Final")
   Set Wbk = Workbooks.Open("C:\Users\unknown\Documents\Reference.xlsx")
   Set ExWs = Wbk.Worksheets("Sheet1")
   
   With CreateObject("scripting.dictionary")
      For Each Cl In ExWs.Range("B1", ExWs.Range("B" & Rows.count).End(xlUp))
         If Not .Exists(Cl.Value) Then .Add Cl.Value, Cl.Offset(, 1).Resize(, 4)
      Next Cl
      For Each Cl In Tws.Range("F2", Tws.Range("F" & Rows.count).End(xlUp))
         If .Exists(Cl.Value) Then Cl.Offset(, 1).Resize(, 4).Value = .Item(Cl.Value).Value
      Next Cl
   End With
   Wbk.Close False
End Sub

 

[rlv01]

Not tested.

Sub ProjectLookUp()
    Dim rw As Long, x As Range, ColF As Range, R As Range
    Dim extwbk As Workbook, twb As Workbook

    Set twb = ThisWorkbook
    Set extwbk = Workbooks.Open("C:\Users\unknown\Documents\Reference.xlsx")

    'Set x = extwbk.Worksheets("Sheet1").Range("B1:I100000")
    With extwbk.Worksheets("Sheet1")
        Set x = .Range("B1:F" & .Range("B" & .Rows.Count).End(xlUp).Row)
    End With

    With twb.Sheets("Final")
        Set ColF = .Range("F2:F" & .Range("F" & .Rows.Count).End(xlUp).Row)
    End With

    For Each R In ColF
        For rw = 1 To 5
            R.Offset(0, rw).Value = Application.VLookup(R.Value, x, rw, False)
        Next rw
    Next R

    extwbk.Close savechanges:=False
End Sub

 

[rlv01]

FWIW, I should mention that my post above is to illustrate how VLOOKUP can be used to get all the column data you want. But since you basically do the same search 5 times (for rw = 1 to 5) it can be slow if the lookup range is large. As fluff has shown in his post there are alternate ways that may be faster.

 

[unknownymous]

Amazing! Thanks Fluff and rlv01 for all your help and insight.

 

[unknownymous]

One last thing, can you possibly help me figure out why the look up codes doesn't work here? I think I'm missing something.

-----------------------------------------------------------

Sub PROJECT()


Dim Lst As Long
Dim SrchRng As Range, cel As Range, s As Integer
Dim lr As Long


Dim Cl As Range
Dim Wbk As Workbook
Dim ExWs As Worksheet, Tws As Worksheet


lr = Cells(Rows.Count, "B").End(xlUp).Row
Set SrchRng = Range("B1:B" & lr)
s = 0
For Each cel In SrchRng
If s = 1 Then Exit Sub
If InStr(1, cel.Value, "SECURITY") > 0 Then
cel.EntireRow.Insert
s = s + 1
End If




Range("A1").Select


'----- This part is not working

Set Tws = ThisWorkbook.Sheets("PROCESSED")
Set Wbk = Workbooks.Open("C:\Users\unknown\Documents\Referencexlsx")
Set ExWs = Wbk.Worksheets("MAPPED")


With CreateObject("scripting.dictionary")
For Each Cl In ExWs.Range("B1", ExWs.Range("B" & Rows.Count).End(xlUp))
If Not .Exists(Cl.Value) Then .Add Cl.Value, Cl.Offset(, 1).Resize(, 5)
Next Cl
For Each Cl In Tws.Range("F2", Tws.Range("F" & Rows.Count).End(xlUp))
If .Exists(Cl.Value) Then Cl.Offset(, 1).Resize(, 5).Value = .Item(Cl.Value).Value
Next Cl
End With
Wbk.Close False






Range("A1").Select


End Sub


--------------------------------------------------------------------

Thanks in advance!

 

[Fluff]

In what way "doesn't it work"?

 

[unknownymous]

It doesn't proceed with running or some like it was skipped.

Corrected this part (still not working): Set Wbk = Workbooks.Open("C:\Users\unknown\Documents\Reference.xlsx")

 

[Fluff]

Are you sure that the path & filename are correct?

 

[unknownymous]

Yes, fluff. I tried to reverse the code like Look Up first then separate and seems working now.

I think I'm just missing something.

Thanks!