VBA Copy and Paste Vlookup to Range

[avd88]

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:

'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]

Do you want a formula in those cells, or just the result as a hard value?

 

[avd88]

At the end I need the result as a hard value. Which is what I'm trying to do here:

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

 

[Fluff]

I take it that J2 on the upload sheets contains a number signifying which column to return?

 

[Fluff]

Assuming my assumption in post#4 is correct try

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("Quota")
      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 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("D2").Resize(r - 1).Value = Nary
   End With
End Sub

 

[avd88]

Yes, column J is basically a loop with numbers from 4 - 15 that repeat themselves which are the columns I need to pull data from. So I have one id and I'm pulling 12 data points (12 months of quotas).

Unfortunately it didn't work just ended up with a blank column. I'm not familiar with some of the syntax on your code so it's hard for me to identify where it's failing. My code although less elegant is almost working except for the part on where I'm trying to copy formulas it copies the formula with the first ID for the vlookup and the First Column for the vlookup all the way down.

 

[Fluff]

Yes, column J is basically a loop with numbers from 4 - 15

There is no mention of that in your op & no loop in your code.

except for the part on where I'm trying to copy formulas

You are not copying any formula, you are calculating one value & then pasting that in multiple rows.

To do it like your code you have no option but to loop don the rows calculating the lookup each time.

 

[avd88]

Sorry if I missed some information!
Basically the vlookup is the last section of my code. At that point I have several columns the last two columns are the columns for the vlookups and the IDs for the vlookups which are being cleared once I get the hard coded values from the Vlookups on column D. Here is an image:

The code I was using below was looping through and was working but based on the data size it adds 15+ minutes to run which is pretty inefficient.

Here is the code I was using:

'ADD VLOOKUP

v = Worksheets("Upload").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count - 1

For i = 1 To v

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("J" & c), False)

Next i

j = Worksheets("Upload").Range("D:D").Cells.SpecialCells(xlCellTypeConstants).Count

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

Thanks for all your replies BTW!!!

 

[Fluff]

Ok, roughly how many rows of data do you have on the Quota sheet & do you need to return columns 4 to 15 for every value in col K?

 

[avd88]

It's a monthly upload so the data will vary but at this time I calculate 40k - 50k rows.

Correct, I have a table with quotas so I basically need to pull each month's quota for each Person / Product Combination.

So Period 1 to Period 12 for Person 1/Product A then Period 1 to Period 12 for Person 1/ Product B. Once all the products are done for that person the list starts with that logic again for Person 2.

So I'm pulling from a table like this one: