VBA code to calculate, copy, paste, and repeat the process in a loop

[rocketch]

Hello,

I wanted to automate calculations of the sumproduct of two arrays of variables which could iterate for dozens/hundreds of times, and then copy the results to a column, and then repeat the process, and copy the new results to a column next to the previous one. Upon completion of all the iterations, I wanted to add up all the results copied in the columns by row, and copy the sum of each row to each cell in a designated range one by one.

The code seems to be running without warnings, but the major issue seems to be that after each calculation, the results that are copied to the columns would be overwritten by the following calculated results. Also, the calculations seem to be taking some time to complete although it seems to be simple calculations.

Any help with reviewing and advising the following codes is much apprecited!

Sub Macro1() ' ' Macro1 Macro ' calculate total emissions from transport '

Dim rowcount As Long

rowcount = Worksheets("Building Components").Range("Transport_Raw_Materials").Rows.Count

rowcount_results_total = Worksheets("Building Components").Range("TD_RawMaterial_Results_Total").Rows.Count rowcount_results_urban = Worksheets("Building Components").Range("TD_RawMaterial_Results_Urban").Rows.Count

rowcount_results_total_items = Worksheets("Factors_T&D").Range("TD_RawMaterial_Results_Total_Items").Rows.Count rowcount_results_urban_items = Worksheets("Factors_T&D").Range("TD_RawMaterial_Results_Urban_Items").Rows.Count

Dim i As Integer

For i = 1 To rowcount
Worksheets("Factors_T&D").Range("Truck_ModeShare_Raw_Material") = Worksheets("Building Components").Range("Transport_Raw_Materials").Cells(i, 2).Value
Worksheets("Factors_T&D").Range("Rail_ModeShare_Raw_Material") = Worksheets("Building Components").Range("Transport_Raw_Materials").Cells(i, 3).Value
Worksheets("Factors_T&D").Range("Tanker_ModeShare_Raw_Material") = Worksheets("Building Components").Range("Transport_Raw_Materials").Cells(i, 4).Value
Worksheets("Factors_T&D").Range("Truck_Dist_Raw_Material") = Worksheets("Building Components").Range("Transport_Raw_Materials").Cells(i, 5).Value
Worksheets("Factors_T&D").Range("Rail_Dist_Raw_Material") = Worksheets("Building Components").Range("Transport_Raw_Materials").Cells(i, 6).Value
Worksheets("Factors_T&D").Range("Tanker_Dist_Raw_Material") = Worksheets("Building Components").Range("Transport_Raw_Materials").Cells(i, 7).Value

ActiveCell.FormulaR1C1 = "=SUMPRODUCT(RC[" & -3 - i & "]:RC[" & -1 - i & "],R38C27:R38C29)" 'This is where the sumproduct calculation occurs, but I would like to have the calculation go regardless of which particular active cell my mouse pointer in the spreadsheet happens to be'
Worksheets("Factors_T&D").Calculate
Range("Ae53").Offset(0, i - 1).Select
Selection.AutoFill Destination:=Range("Ae53:Ae58").Offset(0, i - 1), Type:=xlFillDefault
Range("Ae53:Ae58").Offset(0, i - 1).Select
Range("Ae58").Offset(0, i - 1).Select
Selection.Copy
Range("Ae60:Ae70").Offset(0, i - 1).Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=12
Range("Ae72:Ae79").Offset(0, i - 1).Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=-12
Application.CutCopyMode = False
Range("Ae52").Offset(0, i - 1).Value = Worksheets("Building Components").Range("List_Raw_Materials").Cells(i).Value

Range("Ae53").Offset(0, i).Select
Next i

For i = 1 To rowcount_results_total Worksheets("Building Components").Range("TD_RawMaterial_Results_Total").Cells(i) = WorksheetFunction.Sum(Worksheets("Factors_T&D").Range(Range("TD_RawMaterial_Results_Total_Items").Cells(i), Range("TD_RawMaterial_Results_Total_Items").Cells(i).End(xlToRight))) Next i

For i = 1 To rowcount_results_urban Worksheets("Building Components").Range("TD_RawMaterial_Results_Urban").Cells(i) = WorksheetFunction.Sum(Worksheets("Factors_T&D").Range(Range("TD_RawMaterial_Results_Urban_Items").Cells(i), Range("TD_RawMaterial_Results_Urban_Items").Cells(i).End(xlToRight))) Next i

Calculate

End Sub

 

[offthelip]

your code is always going to be very very slow, this is because you are making multiple access to the worksheet in 3 different loops. To do what you are trying to do you shouldn't try using worksheet functions at all you should do the entire calculation in VBA by loading ALL of the data from you worksheet into variant arrays and then looping through the variant array rather than copying variable from one place to another on your worksheet . To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action. So find out how to use variant arrays and it should solve a your timing problem. Just as an example here is some code that does a sumproduct of values in A2:B14:

Sub test()
array1 = Range(Cells(1, 1), Cells(14, 1))
array2 = Range(Cells(1, 2), Cells(14, 2))
sump = 0
For i = 1 To UBound(array1, 1)
 sump = sump + array1(i, 1) * array2(i, 1)
Next i
MsgBox sump


End Sub

 

[rocketch]

Thank you so much!
I tried to revise the code according to your suggestion. Now I am putting all the data into one worksheet, and define the worksheet as a variable to make the code more readable (and hopefully would also be time efficient, but I am not sure). It is like this: Dim bldgCompWS As Worksheet; Set bldgCompWS = Worksheets("Building Components")

Also, I defined a 2-D array instead of the 1-D array you showed me. However, I run into a problem. I think the problem is that I don't know how to initialize the 2-D array, SumProduct_EW(p_EW), to be zero.

Could you please help me how I could revise the code below (probably the line in red):

Dim SumProduct_EW() As Long
Dim i As Integer
Dim p_EW As Integer
Dim q_EW As Integer

For p_EW = 1 To 6
For q_EW = 1 To 3
SumProduct_EW(p_EW) = SumProduct_EW(p_EW) + bldgCompWS.Range("TD_ModeShare").Cells(1, q_EW) * bldgCompWS.Range("TD_EnergyWater").Cells(p_EW, q_EW)
Next q_EW
bldgCompWS.Range("TD_Start").Offset(p_EW - 1, i + 1).Value = SumProduct_EW(p_EW, 1)
Next p_EW

Thank you! I really appreciate your help!

 

[rocketch]

And in case it might help, and if you wouldn't mind taking a look at the entire code, here it is:

Dim i As Integer
Dim p_EW As Integer
Dim q_EW As Integer
Dim p_TE As Integer
Dim q_TE As Integer
Dim p_U As Integer
Dim q_U As Integer
Dim SumProduct_EW() As Long

Dim SumProduct_TE() As Long

Dim SumProduct_U() As Long

Dim Results_Start_EW() As Long



For i = 1 To rowcount
bldgCompWS.Range("Truck_ModeShare_Raw_Material") = bldgCompWS.Range("Transport_Raw_Materials").Cells(i, 2).Value
bldgCompWS.Range("Rail_ModeShare_Raw_Material") = bldgCompWS.Range("Transport_Raw_Materials").Cells(i, 3).Value
bldgCompWS.Range("Tanker_ModeShare_Raw_Material") = bldgCompWS.Range("Transport_Raw_Materials").Cells(i, 4).Value
bldgCompWS.Range("Truck_Dist_Raw_Material") = bldgCompWS.Range("Transport_Raw_Materials").Cells(i, 5).Value
bldgCompWS.Range("Rail_Dist_Raw_Material") = bldgCompWS.Range("Transport_Raw_Materials").Cells(i, 6).Value
bldgCompWS.Range("Tanker_Dist_Raw_Material") = bldgCompWS.Range("Transport_Raw_Materials").Cells(i, 7).Value

bldgCompWS.Calculate

For p_EW = 1 To 6
For q_EW = 1 To 3
SumProduct_EW(p_EW) = SumProduct_EW(p_EW) + bldgCompWS.Range("TD_ModeShare").Cells(1, q_EW) * bldgCompWS.Range("TD_EnergyWater").Cells(p_EW, q_EW)
Next q_EW
bldgCompWS.Range("TD_Start").Offset(p_EW - 1, i + 1).Value = SumProduct_EW(p_EW)
Next p_EW

For p_TE = 1 To 11
For q_TE = 1 To 3
SumProduct_TE(p_TE) = SumProduct_TE(p_TE) + bldgCompWS.Range("TD_ModeShare").Cells(1, q_TE) * bldgCompWS.Range("TD_TotalEmissions").Cells(p_TE, q_TE)
Next q_TE
bldgCompWS.Range("TE_Start").Offset(p_TE - 1, i + 1).Value = SumProduct_TE(p_TE, 1)
Next p_TE

For p_U = 1 To 8
For q_U = 1 To 3
SumProduct_U(p_U) = SumProduct_U(p_U) + bldgCompWS.Range("TD_ModeShare").Cells(1, q_U) * bldgCompWS.Range("TD_UrbanEmissions").Cells(p_U, q_U)
Next q_U
bldgCompWS.Range("U_Start").Offset(p_U - 1, i + 1).Value = SumProduct_U(p_U, 1)

Next p_U

Next i


For p_EW = 1 To 6
bldgCompWS.Range("TD_Results_EW").Cells(p_EW) = WorksheetFunction.Sum(bldgCompWS.Range(Range("TD_Start").Offset(p_EW - 1, 2), Range("TD_Start").Offset(p_EW - 1, rowcount + 1)))
Next p_EW

For p_TE = 1 To 11
bldgCompWS.Range("TD_Results_TE").Cells(p_TE) = WorksheetFunction.Sum(bldgCompWS.Range(Range("TE_Start").Offset(p_TE - 1, 2), Range("TE_Start").Offset(p_TE - 1, rowcount + 1)))
Next p_TE

For p_U = 1 To 8
bldgCompWS.Range("TD_Results_Urban").Cells(p_U) = WorksheetFunction.Sum(bldgCompWS.Range(Range("U_Start").Offset(p_U - 1, 2), Range("U_Start").Offset(p_U - 1, rowcount + 1)))
Next p_U


End Sub

 

[offthelip]

I have made an effort to rewrite your code in comment #3 using variant arrays, however I can't test that I have got the addressing correct because the worksheets and named ranges aren't defined
Although in your code you have avoided using the worksheet function you are still addressing the worksheet multiple times in a loop, every time you address a range or a cell it takes a few milliseconds.
this code shows you how to load the data into a variant array, define an output array, then do all the processing moving data from one array to another, then write the output array back to the worksheet.

Sub test()
Dim SumProduct_EW() As Long
Dim i As Integer
Dim p_EW As Integer
Dim q_EW As Integer

' load one array with named range TD_MODESHARE data
msArray = bldgCompWS.Range("TD_ModeShare")
' Load second array with named range TD_ENERGYWATER
ewarray = bldgCompWS.Range("TD_EnergyWater")
' Load output array with named range TD_Start
outarray = bldgCompWS.Range("TD_Start")

For p_EW = 1 To 6
For q_EW = 1 To 3
SumProduct_EW(p_EW) = SumProduct_EW(p_EW) + msArray(1, q_EW) * ewarray(p_EW, q_EW)
Next q_EW
outarray(p_EW - 1, i + 1) = SumProduct_EW(p_EW, 1)
Next p_EW
' write output array back to range TD_Start
bldgCompWS.Range("TD_Start") = outarray


End Sub

 

[rocketch]

Hi friend,
Thank you so much for your continuous help and guidance!
It has been a really busy day for me, and I just got a chance to say thank you and revise the code according to your suggestions.
At this point, there is an issue with this line of code with a warning: "Run-time error '9' Subscript out of range.

SumProduct_EW(p_EW) = SumProduct_EW(p_EW) + msArray(1, q_EW) * ewArray(p_EW, q_EW).

I think that the problem might be that we didn't initialize SumProduct_EW(p_EW) to be zero for each p_EW going from 1 to 6.

Could you please advise how I could address this issue?

Also, bldgCompWS.Range("TD_Start") is really just one particular cell. I wanted to put the sumproduct value 2 cells to the right of this cell. So, when it is assigned to the variable outarray, I wonder if it makes sense to reference outarray(p_EW - 1, i + 1), which seems to be an array, but not just a single cell.

I apologize if this is confusing to you, but I really appreciate your time and help!

Sincerely,

 

[offthelip]

You are absolutely correct about not initialising sumproduct_Ew(P_Ew) at the start of each loop , that should be done , my mistake.
However that is NOT the cause of the subscript out of range error. I think that this is because we haven't defined Sumproduct_EW as an array, .
There are some other possible causes of the out of range error.
msarray size is defined by the size of the TD_MODESHARE named array which in your code you addressed with the index (1,q_EW) with q_EW going from 1 to 3. So this presumes that TD_MODESHARE is one row by 3 columns
ewarray is defined by the named range TD_Energywater and in the same way this must be 6 rows by 3 columns for the code to work.
Finally if what you are really trying to do is output the complete sum in one cell then output does need to be different, we can use a single variant variable rather than an array so try this:

Sub test()
Dim SumProduct_EW(1 To 6) As Long
Dim i As Integer
Dim p_EW As Integer
Dim q_EW As Integer
Dim output As Variant

' load one array with named range TD_MODESHARE data
msArray = bldgCompWS.Range("TD_ModeShare")
' Load second array with named range TD_ENERGYWATER
ewarray = bldgCompWS.Range("TD_EnergyWater")
' Load output  with named range TD_Start
output = 0

For p_EW = 1 To 6
SumProduct_EW(p_EW) = 0
For q_EW = 1 To 3
SumProduct_EW(p_EW) = SumProduct_EW(p_EW) + msArray(1, q_EW) * ewarray(p_EW, q_EW)
Next q_EW
output = output + SumProduct_EW(p_EW, 1)
Next p_EW
' write output back to range TD_Start
bldgCompWS.Range("TD_Start") = output

Note; I try to avoid using Named ranges when I am working with VBA because of exactly the problem of not knowing what the named ranges are. There are ways around it to make sure the code works regardless of the size of the named range but it makes it more complicated
I have just notice you wanted the results two cell to the right of TD_START. I suggest using offset