VBA Copy and Paste Vlookup to Range

avd88

Board Regular
Joined
Jan 18, 2016
Messages
79
Hello,

I have some VBA code I was using where I was looping through a range to add vlookups to a list.
I'm trying to do the same thing for a similar project but have a way larger dataset. 50k lines so it's pretty inefficient to use a loop.

I'm trying to add the formula to the first item on the list and then copy and paste the formula to the range. I did something similar to a concatenation to create the vlookup id's and it worked.
The issue I'm having is the vlookup is copying the formula but it is copying the vlookup for the first item all the way down. I need to formula to act dynamically when I copy and paste the formulas. Any idea on how to solve this?

Here is my code:

VBA Code:
'ADD VLOOKUP AND AUTOFILL QUOTA

j = Worksheets("Upload").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
c = Worksheets("Upload").Range("D:D").Cells.SpecialCells(xlCellTypeConstants).Count + 1

Cells(c, 4).Select
ActiveCell = Application.WorksheetFunction.VLookup(Sheets("Upload").Range("K" & c), Sheets("Quota").Range("A:O"), Sheets("Upload").Range("J2"), False)
Cells(c, 4).Copy
Worksheets("Upload").Range("D" & 3 & ":D" & j).PasteSpecial Paste:=xlPasteFormulas

Worksheets("Upload").Range("D" & 2 & ":D" & j).Copy
Worksheets("Upload").Range("D" & 2 & ":D" & j).PasteSpecial Paste:=xlPasteValues
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,406
Office Version
  1. 365
Platform
  1. Windows
Ok, how about
VBA Code:
Sub avd()
   Dim Ary As Variant, Nary As Variant, Tmp(4 To 15) As Variant
   Dim Dic As Object
   Dim c As Long, r As Long
   
   Set Dic = CreateObject("scripting.dictionary")
   
   With Sheets("pcode")
      Ary = .Range("A1:O" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   For r = 1 To UBound(Ary)
      If Not Dic.Exists(Ary(r, 1)) Then
         For c = 4 To 15
            Tmp(c) = Ary(r, c)
         Next c
         Dic.Add Ary(r, 1), Tmp
      End If
   Next r
   With Sheets("Upload")
      Ary = .Range("J2", .Range("K" & Rows.Count).End(xlUp)).Value2
      ReDim Nary(1 To UBound(Ary), 1 To 1)
      For r = 1 To UBound(Ary)
         If Dic.Exists(Ary(r, 2)) Then Nary(r, 1) = Dic(Ary(r, 2))(Ary(r, 1))
      Next r
      .Range("D2").Resize(r - 1).Value = Nary
   End With
End Sub
 
Solution

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney

avd88

Board Regular
Joined
Jan 18, 2016
Messages
79
Thanks for the reply and your help! Unfortunately I still end up with a blank column, I'll keep trying finding a different method to avoid looping through the whole data set.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,406
Office Version
  1. 365
Platform
  1. Windows
Did you get any error messages?
 

avd88

Board Regular
Joined
Jan 18, 2016
Messages
79
Just got it to work!! I didn't have time until right now to properly look at this. I was replacing the "pcode" worksheet with the result worksheet instead of the lookup table.
Thanks you are the best!

I'll take some time to dissect your code, looks impressive. Definitely above my skillset today.
 

Fluff

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

ADVERTISEMENT

You're welcome & thanks for the feedback.
 

avd88

Board Regular
Joined
Jan 18, 2016
Messages
79
Hi @Fluff, is there any chance you could help me use the same logic for another section of the same project. I just realize I was having the same issue where I'm copying the value of the first vlookup all the way down. I tried moving around the code that you sent over but I haven't been able to get it.

This one is simpler; I basically need to use the values in column A starting with A2 of the Upload worksheet and vlookup to the 2nd column of the worksheet List of Reps all the way down. Again looping through it is not an option due to the size of the list.

This was the code I was using:

VBA Code:
'ADD VLOOKUP AND AUTOFILL USER ID

c = Worksheets("Upload").Range("B:B").Cells.SpecialCells(xlCellTypeConstants).Count + 1
j = Worksheets("Upload").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count

Cells(c, 2).Select
ActiveCell = Application.WorksheetFunction.VLookup(Sheets("Upload").Range("A" & c), Sheets("List of Reps").Range("A:B"), 2, False)
Cells(c, 2).Copy
Worksheets("Upload").Range("B" & 3 & ":B" & j).PasteSpecial Paste:=xlPasteFormulas

Worksheets("Upload").Range("B" & 2 & ":B" & j).Copy
Worksheets("Upload").Range("B" & 2 & ":B" & j).PasteSpecial Paste:=xlPasteValues
 

Fluff

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

ADVERTISEMENT

How about
VBA Code:
Sub avd()
   Dim Ary As Variant, Nary As Variant
   Dim Dic As Object
   Dim c As Long, r As Long
   
   Set Dic = CreateObject("scripting.dictionary")
   c = Sheets("Upload").Range("J2").Value
   
   With Sheets("List of reps")
      Ary = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   For r = 1 To UBound(Ary)
      If Not Dic.Exists(Ary(r, 1)) Then Dic.Add Ary(r, 1), Ary(r, c)
   Next r
   With Sheets("Upload")
      Ary = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value2
      ReDim Nary(1 To UBound(Ary), 1 To 1)
      For r = 1 To UBound(Ary)
         If Dic.Exists(Ary(r, 1)) Then Nary(r, 1) = Dic(Ary(r, 1))
      Next r
      .Range("B2").Resize(r - 1).Value = Nary
   End With
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,406
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,288
Messages
5,635,333
Members
416,855
Latest member
niha

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top