Writing an array formula to a large number of cells

Question

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

• PeterT: 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).
• Tim Eckmann: @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?

Answer 1

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
'--- establish column headers
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
Dim dataDict As Dictionary
Set dataDict = LookupDictionary(lookupRange)

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
 newDict.Add newKey, dataArray(i, numCols)
 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
 '--- establish column headers
 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 dataDict As Dictionary
 Set dataDict = LookupDictionary(lookupRange)
 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
 Set dataDict = Nothing
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
 newDict.Add newKey, dataArray(i, numCols)
 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.

• Tim Eckmann: 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?
• PeterT: 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.
• Tim Eckmann: 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.
• PeterT: 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.
• Tim Eckmann: 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.

Answer 2

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

• Stephen Rauch: 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: Nicely done! Again, welcome.
• Tim Eckmann: @Yoni thank you for the suggestion. I tried it out, but it didn't really improve the performance.