# Writing an array formula to a large number of cells

I am working on a script to write an array formula to a large number of cells. I have a code that works, but is very slow. Any thoughts on how to speed it up? The end goal is to be able to quickly write an array formula to several cells. The problem is that each cell has a unique formula. So I couldn't think of a way to simplify the code. Here is the code as it is written now:

Sub make_sheet()

Dim m As Integer
Dim h As Integer
Dim a As Integer
Dim b As Integer
Dim dt As String
Dim man As String

m = 10005
h = 2
a = 1
dt = ActiveWorkbook.Sheets("DCAM2_REVD-ODB-11-18-2016_2017-").Cells(2, 4).Value
man = InputBox("Who Manufactured the PCB?", "Manufacture")

ActiveWorkbook.Sheets("Sheet1").Cells(1, 6).FormulaR1C1 = "time/date stamp of test"
ActiveWorkbook.Sheets("Sheet1").Cells(1, 7).FormulaR1C1 = "Manufacturer"
ActiveWorkbook.Sheets("Sheet1").Cells(1, 12).FormulaR1C1 = "Channel"

For i = 2 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(i, 6).FormulaR1C1 = dt
Next i

For i = 2 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(i, 7).FormulaR1C1 = man
Next i

b = 0
For i = 2 To 11 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(i, 12).FormulaR1C1 = "DS0" & b & ""
b = b + 1
Next i

b = 10
For i = 12 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(i, 12).FormulaR1C1 = "DS" & b & ""
b = b + 1
Next i

For i = 13 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(1, i).FormulaR1C1 = "A" & a & ""
a = a + 1
Next i

a = 1
For i = 18 To 29 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(1, i).FormulaR1C1 = "P" & a & ""
a = a + 1
Next i

For i = 13 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(2, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_" & h & "_13_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(2, i).NumberFormat = "0.00"
h = h + 1
Next i

h = 1
For i = 18 To 29 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(2, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_2_" & h & "_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(2, i).NumberFormat = "0.00"
h = h + 1
Next i

m = m + 1000
h = 2
For i = 13 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(3, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_" & h & "_13_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(3, i).NumberFormat = "0.00"
h = h + 1
Next i

h = 1
For i = 18 To 29 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(3, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_2_" & h & "_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(3, i).NumberFormat = "0.00"
h = h + 1
Next i

m = m + 1000
h = 2
For i = 13 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(4, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_" & h & "_13_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(4, i).NumberFormat = "0.00"
h = h + 1
Next i

h = 1
For i = 18 To 29 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(4, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_2_" & h & "_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(4, i).NumberFormat = "0.00"
h = h + 1
Next i

m = m + 1000
h = 2
For i = 13 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(5, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_" & h & "_13_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(5, i).NumberFormat = "0.00"
h = h + 1
Next i

h = 1
For i = 18 To 29 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(5, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_2_" & h & "_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(5, i).NumberFormat = "0.00"
h = h + 1
Next i

m = m + 1000
h = 2
For i = 13 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(6, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_" & h & "_13_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(6, i).NumberFormat = "0.00"
h = h + 1
Next i

h = 1
For i = 18 To 29 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(6, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_2_" & h & "_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(6, i).NumberFormat = "0.00"
h = h + 1
Next i

m = m + 1000
h = 2
For i = 13 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(7, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_" & h & "_13_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(7, i).NumberFormat = "0.00"
h = h + 1
Next i

h = 1
For i = 18 To 29 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(7, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_2_" & h & "_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(7, i).NumberFormat = "0.00"
h = h + 1
Next i

m = m + 1000
h = 2
For i = 13 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(8, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_" & h & "_13_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(8, i).NumberFormat = "0.00"
h = h + 1
Next i

h = 1
For i = 18 To 29 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(8, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_2_" & h & "_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(8, i).NumberFormat = "0.00"
h = h + 1
Next i

m = m + 1000
h = 2
For i = 13 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(9, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_" & h & "_13_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(9, i).NumberFormat = "0.00"
h = h + 1
Next i

h = 1
For i = 18 To 29 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(9, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_2_" & h & "_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(9, i).NumberFormat = "0.00"
h = h + 1
Next i

m = m + 1000
h = 2
For i = 13 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(10, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_" & h & "_13_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(10, i).NumberFormat = "0.00"
h = h + 1
Next i

h = 1
For i = 18 To 29 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(10, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_2_" & h & "_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(10, i).NumberFormat = "0.00"
h = h + 1
Next i

m = m + 1000
h = 2
For i = 13 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(11, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_" & h & "_13_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(11, i).NumberFormat = "0.00"
h = h + 1
Next i

h = 1
For i = 18 To 29 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(11, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_2_" & h & "_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(11, i).NumberFormat = "0.00"
h = h + 1
Next i

m = m + 1000
h = 2
For i = 13 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(12, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_" & h & "_13_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(12, i).NumberFormat = "0.00"
h = h + 1
Next i

h = 1
For i = 18 To 29 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(12, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_2_" & h & "_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(12, i).NumberFormat = "0.00"
h = h + 1
Next i

m = m + 1000
h = 2
For i = 13 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(13, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_" & h & "_13_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(13, i).NumberFormat = "0.00"
h = h + 1
Next i

h = 1
For i = 18 To 29 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(13, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_2_" & h & "_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(13, i).NumberFormat = "0.00"
h = h + 1
Next i

m = m + 1000
h = 2
For i = 13 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(14, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_" & h & "_13_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(14, i).NumberFormat = "0.00"
h = h + 1
Next i

h = 1
For i = 18 To 29 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(14, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_2_" & h & "_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(14, i).NumberFormat = "0.00"
h = h + 1
Next i

m = m + 1000
h = 2
For i = 13 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(15, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_" & h & "_13_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(15, i).NumberFormat = "0.00"
h = h + 1
Next i

h = 1
For i = 18 To 29 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(15, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_2_" & h & "_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(15, i).NumberFormat = "0.00"
h = h + 1
Next i

m = m + 1000
h = 2
For i = 13 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(16, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_" & h & "_13_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(16, i).NumberFormat = "0.00"
h = h + 1
Next i

h = 1
For i = 18 To 29 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(16, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_2_" & h & "_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(16, i).NumberFormat = "0.00"
h = h + 1
Next i

m = m + 1000
h = 2
For i = 13 To 17 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(17, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_" & h & "_13_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(17, i).NumberFormat = "0.00"
h = h + 1
Next i

h = 1
For i = 18 To 29 Step 1
ActiveWorkbook.Sheets("Sheet1").Cells(17, i).FormulaArray = "=Product(0.03937,(VLOOKUP(""U" & m & """&""#_2_" & h & "_Hei"",CHOOSE({1,2},'DCAM2_REVD-ODB-11-18-2016_2017-'!B:B&'DCAM2_REVD-ODB-11-18-2016_2017-'!E:E,'DCAM2_REVD-ODB-11-18-2016_2017-'!H:H),2,0)))"
ActiveWorkbook.Sheets("Sheet1").Cells(17, i).NumberFormat = "0.00"
h = h + 1
Next i

End Sub

• Is there a requirement for the formula results to change once you fill out the worksheet? If the data behind the VLOOKUP and Productformulas will change, then your array formulas may be a good choice. But if you're constructing the worksheet and results only once, then you'd get better VBA performance if you calculated all the results using a VBA function and insert the results directly (without worksheet formulas). – PeterT Mar 24 '17 at 14:41
• @PeterT It is a one time update. I'm not that familiar with running array formulas in a VBA Function. Could you give me an example of how it would look? – Tim Eckmann Mar 24 '17 at 16:44

You have a good start on what you need to do because you've nailed down the loops and formulas you want to see in the end result. Bonus points goes to you for not using Select or Activate! Let's take your VBA to the next level.

First, help yourself out by creating interim values/objects that more accurately (and simply) reference your data. In this case Always define and set references to all Workbooks and Sheets:

Dim wb As Workbook
Dim sourceWS As Worksheet
Dim destWS As Worksheet
Dim man As String
Set wb = ActiveWorkbook
Set sourceWS = wb.Sheets("DCAM2_REVD-ODB-11-18-2016_2017-")
Set destWS = wb.Sheets("Sheet1")


Second, help yourself even more by establishing some constants to help identify fixed values, such as specific columns or limits. This is especially helpful if you ever need to change the value because you only need to change it in one place. Also, use meaningful names for variables so that you can more easily "read" your code without having to interpret it inside your head (such as the "source" and "destination" variables).

'--- column indexes
Const TIMESTAMP = 6
Const MFG = 7
Const CHAN = 12

destWS.Cells(1, TIMESTAMP) = "time/date stamp of test"
destWS.Cells(1, MFG) = "Manufacturer"
destWS.Cells(1, CHAN) = "Channel"

Dim dateTime As Date
Dim mfgInput As String
dateTime = sourceWS.Cells(2, 4).Value
mfgInput = InputBox("Who Manufactured the PCB?", "Input Manufacturer")

Const MAX_CHANNELS = 16
Const MAX_A = 5
Const MAX_P = 12

Dim i As Long
For i = 2 To MAX_CHANNELS + 1
destWS.Cells(i, TIMESTAMP) = Format(dateTime, "dd-mmm-yyyy")
destWS.Cells(i, MFG) = mfgInput
destWS.Cells(i, CHAN) = "DS" & Format(i - 2, "0#")
Next i


Third is a bit more advanced. It looks like each time you need a VLOOKUP formula, you're referring to the same set of values in three columns. This doesn't seem to change, so that data (and therefore the resulting calculation) is static -- which means you don't really need a formula. You can calculate the value right in the VBA and drop the result in the cell.

The VLOOKUP is using the nifty CHOOSEfunction to achieve a multi-variable vlookup. Very cool stuff, but you do it much quicker in VBA with a Dictionary in the VBA (rather than on the worksheet).

You are concatenating values in Columns B and E to select a value in Column H. So to get the resulting Dictionary, I'm doing two things: a) moving those columns into a memory array (for speed), and b) building a Dictionary with keys.

Dim lookupRange As Range
Set lookupRange = Application.Union(destWS.Range("B1:B1000"), _
destWS.Range("e1:e1000"), _
destWS.Range("h1:h1000"))
'--- create a Dictionary of all the lookup data


Because your columns are NOT contiguous (next to each other), I'm using a nifty function from @TimWilliams (found here). Then creating the Dictionary by combining the first two columns in the array (which come from columns B and E on the worksheet), into a single string Key for each row. The value on that row in column H is stored as the Dictionary.Item.

Function LookupDictionary(ByRef dataRange As Range) As Dictionary
'--- the dataRange may be either a contiguous or non-contiguous area
'    of cells. it will be transferred to a memory array first before
'    translating into a Dictionary. all columns except the last column
'    are concatenated into a single string Key for the Dictionary. the
'    value in the last column is stored as the Item value.
Dim dataArray As Variant
dataArray = ToArray(dataRange)
Dim numRows As Long
Dim numCols As Long
numRows = UBound(dataArray, 1)
numCols = UBound(dataArray, 2)

Dim newDict As Dictionary
Set newDict = New Dictionary

Dim i As Long
Dim j As Long
For i = 1 To numRows
Dim newKey As String
newKey = ""
For j = 1 To numCols - 1
newKey = newKey & dataArray(i, j)
Next j
'--- each key must be unique, for duplicate keys
'    only the first key,value is added
If Not newDict.Exists(newKey) Then
End If
Next i
Set LookupDictionary = newDict
End Function


Finally, we get to the real meat of the program. You have many loops duplicated, basically doing the same thing to build up each row in your data set. I'm pretty sure that each row is nearly identical with only some values changing in each row (in the VLOOKUP parts). So what I've done here is to collapse all that into two loops. (I did the first one as an example, you can work the second loop.)

Dim target As String
Dim startCol As Long
Dim j As Long
startCol = 13
For i = 1 To MAX_A
destWS.Cells(1, startCol + i - 1) = "A" & i  '--- column label
For j = 1 To MAX_CHANNELS
target = "U" & Format(10 + (j - 1), "##") & "005#_" & (i + 1) & "_13_Hei"
'--- delete or comment this line after debugging...
Debug.Print target
destWS.Cells(j + 1, startCol + i - 1) = 0.03937 * dataDict.Item(target)
Next j
Next i
startCol = startCol + MAX_A
For i = 1 To MAX_P
destWS.Cells(1, startCol + i - 1) = "P" & i  '--- column label
'--- build up this section just like the one above...
Next i


Those nested loops are adding both the column header and the values. Note that the first loop fills in the data for the A1-A5 data columns. You'll have to copy that code and work it for the P1-P12 columns.

So, as a single module, here is the complete code to start you with:

Option Explicit

Sub MakeSheet()
Dim wb As Workbook
Dim sourceWS As Worksheet
Dim destWS As Worksheet
Dim man As String
Set wb = ActiveWorkbook
Set sourceWS = wb.Sheets("DCAM2_REVD-ODB-11-18-2016_2017-")
Set destWS = wb.Sheets("Sheet1")

'--- column indexes
Const TIMESTAMP = 6
Const MFG = 7
Const CHAN = 12

destWS.Cells(1, TIMESTAMP) = "time/date stamp of test"
destWS.Cells(1, MFG) = "Manufacturer"
destWS.Cells(1, CHAN) = "Channel"

Dim dateTime As Date
Dim mfgInput As String
dateTime = sourceWS.Cells(2, 4).Value
mfgInput = InputBox("Who Manufactured the PCB?", "Input Manufacturer")

Const MAX_CHANNELS = 16
Const MAX_A = 5
Const MAX_P = 12

Dim i As Long
For i = 2 To MAX_CHANNELS + 1
destWS.Cells(i, TIMESTAMP) = Format(dateTime, "dd-mmm-yyyy")
destWS.Cells(i, MFG) = mfgInput
destWS.Cells(i, CHAN) = "DS" & Format(i - 2, "0#")
Next i

Dim lookupRange As Range
Set lookupRange = Application.Union(destWS.Range("B1:B1000"), _
destWS.Range("e1:e1000"), _
destWS.Range("h1:h1000"))
'--- create a Dictionary of all the lookup data

Dim target As String
Dim startCol As Long
Dim j As Long
startCol = 13
For i = 1 To MAX_A
destWS.Cells(1, startCol + i - 1) = "A" & i  '--- column label
For j = 1 To MAX_CHANNELS
target = "U" & Format(10 + (j - 1), "##") & "005#_" & (i + 1) & "_13_Hei"
'--- delete or comment this line after debugging...
Debug.Print target
destWS.Cells(j + 1, startCol + i - 1) = 0.03937 * dataDict.Item(target)
Next j
Next i
startCol = startCol + MAX_A
For i = 1 To MAX_P
destWS.Cells(1, startCol + i - 1) = "P" & i  '--- column label
'--- build up this section just like the one above...
Next i

End Sub

Function LookupDictionary(ByRef dataRange As Range) As Dictionary
'--- the dataRange may be either a contiguous or non-contiguous area
'    of cells. it will be transferred to a memory array first before
'    translating into a Dictionary. all columns except the last column
'    are concatenated into a single string Key for the Dictionary. the
'    value in the last column is stored as the Item value.
Dim dataArray As Variant
dataArray = ToArray(dataRange)
Dim numRows As Long
Dim numCols As Long
numRows = UBound(dataArray, 1)
numCols = UBound(dataArray, 2)

Dim newDict As Dictionary
Set newDict = New Dictionary

Dim i As Long
Dim j As Long
For i = 1 To numRows
Dim newKey As String
newKey = ""
For j = 1 To numCols - 1
newKey = newKey & dataArray(i, j)
Next j
'--- each key must be unique, for duplicate keys
'    only the first key,value is added
If Not newDict.Exists(newKey) Then
End If
Next i
Set LookupDictionary = newDict
End Function

Function ToArray(rng) As Variant()
'--- from: https://stackoverflow.com/a/18994211/4717755
Dim arr() As Variant, r As Long, nr As Long
Dim ar As Range, c As Range, cnum As Long, rnum As Long
Dim col As Range

nr = rng.Areas(1).Rows.Count
ReDim arr(1 To nr, 1 To rng.Cells.Count / nr)
cnum = 0
For Each ar In rng.Areas
For Each col In ar.Columns
cnum = cnum + 1
rnum = 1
For Each c In col.Cells
arr(rnum, cnum) = c.Value
rnum = rnum + 1
Next c
Next col
Next ar

ToArray = arr
End Function


This runs VERY fast because all the processing is performed in memory with VBA and doesn't rely on formulas.

Last notes:

1. When referring to the "values" of Cells, you shouldn't put string data in the .Formula bit. Just add it as the .Value. If you don't use the .Value property of the Cell, it is implied.
2. Stay away from variable names like m, dt, or h. Use a more descriptive name (and you can even keep it short). It will definitely help in the long run.
• I finally have had a chance to play around with this. I keep getting an error referring to the New Dictionary. It is saying "Invalid Use of New keyword." Any suggestions? – Tim Eckmann Mar 30 '17 at 13:19
• You're possibly missing the reference to the proper library for early binding. In the VBA Editor menu, go to Tools> References> Microsoft Scripting Runtime and make sure it's checked and see if that helps. – PeterT Mar 30 '17 at 14:22
• I verified that is checked. I also have an issue where the dataDict.Item errors out, unless I change the Dim dataDict As Dictionary to Dim dataDict As Scripting.Dictionary but then the code doesn't seem to work correctly. I am using Excel 2013. So I don't know if that is the issue. – Tim Eckmann Mar 30 '17 at 14:55
• I'm also using Excel 2013 and it works fine. Can you review this reference and see if you can work some of the examples in test code? That might work out an issue and help to point out a difference in syntax or usage between your setup and mine. – PeterT Mar 30 '17 at 18:00
• Peter, I was able to get it to work. There were 2 issues. First, I had to change all instances of the Dictionary to Scripting.Dictionary, then I found that for the lookupRange, you had it looking at the destination sheet instead of the source sheet. So I changed that and everything is working now. I also added in the number formatting for each cell after it is populated so it was only a 2 decimal number. Thank you again for all the help on this. Problem Solved. – Tim Eckmann Mar 30 '17 at 18:46

Every time you plug a formula into an Excel cell it causes the application to recalculate the new cell and any other cells that were affected indirectly. When you start updating hundreds of cells via macro, it starts to bog things down. This is especially true when formulas are intensive (ie, array formulas).

To circumvent this issue, you can temporarily turn off automatic calculation in Excel using the Application's Calculation property. Doing this will cause Excel to only recalculate once, after you've finished entering all the new formulas.

Try wrapping your code with the following:

Application.Calculation = xlCalculationManual

'CODE CODE CODE

Application.Calculation = xlCalculationAutomatic
Application.Calculate

• Welcome to StackExchange Code Review! Please see: How do I write a good answer?, where you will find: "Every answer must make at least one insightful observation about the code in the question. Answers that merely provide an alternate solution with no explanation or justification do not constitute valid Code Review answers and may be deleted". – Stephen Rauch Mar 24 '17 at 0:07
• Nicely done! Again, welcome. – Stephen Rauch Mar 24 '17 at 6:30
• @Yoni thank you for the suggestion. I tried it out, but it didn't really improve the performance. – Tim Eckmann Mar 24 '17 at 12:43