VBA Lookup Values in Another Workbook

unknownymous

Board Regular
Joined
Sep 19, 2017
Messages
176
Office Version
  1. 2016
Platform
  1. Windows
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. :)
 

Some videos you may like

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,077
Office Version
  1. 365
Platform
  1. Windows
How about
Code:
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

Well-known Member
Joined
May 16, 2017
Messages
771
Not tested.

Code:
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

Well-known Member
Joined
May 16, 2017
Messages
771
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

Board Regular
Joined
Sep 19, 2017
Messages
176
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Amazing! Thanks Fluff and rlv01 for all your help and insight. :)
 
Last edited:

unknownymous

Board Regular
Joined
Sep 19, 2017
Messages
176
Office Version
  1. 2016
Platform
  1. Windows
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,077
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

In what way "doesn't it work"?
 

unknownymous

Board Regular
Joined
Sep 19, 2017
Messages
176
Office Version
  1. 2016
Platform
  1. Windows
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,077
Office Version
  1. 365
Platform
  1. Windows
Are you sure that the path & filename are correct?
 

unknownymous

Board Regular
Joined
Sep 19, 2017
Messages
176
Office Version
  1. 2016
Platform
  1. Windows
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!
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,108,624
Messages
5,523,966
Members
409,547
Latest member
AW2020

This Week's Hot Topics

Top