The below code I have written is to allow me to Sum the results data for every year from 1 to 1000 over a range of 5000 locations. although a 1000 years seems extreme, for the application I am using this makes sense. Column K in the Class Calculation Sheet calculates the Data size for every year for a specific class. I have created the classArray
so that the value in D1, which is where the class is defined, can be updated without having to switch back to the original results sheet where the classes are initially defined.
The Script as it stands works, but takes a very long time to run. I am dealing with 1000 rows and roughly 5000 columns. I have defined the array "arr" which contains the Data size for every year for every class. This 2D array is basically every iteration of column K in the "Class Calculation Sheet" next to each other. At the moment it adds them together row by row as can be seen in the part of code that reads
'creates array of column of Data sizes
arr(i, r) = ws1.Cells(6 + i, 11)
I was wondering if it is possible to assign the entire column "K" to a specific column within the pre defined array of pre defined size? This would mean that the code does not need to iterate through the 1000 rows, only the 5000 columns.
I realise this is a long winded explanation so please let me know if further clarification is required.
Sub UpdateData()
'Speed
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim lastcol3 As Integer
Dim classArray As Variant
Dim numRows As Integer
Dim i As Long
Dim r As Long
Dim j As Long
Dim k As Long
Dim arr
Set wb = ThisWorkbook
Set ws1 = wb.Worksheets("Class Calculation Sheet")
Set ws2 = wb.Worksheets("Data")
Set ws3 = wb.Worksheets("Results")
'MANUAL
Application.Calculation = xlCalculationManual
'Number of Rows of data to be entered
numRows = 1000
'Gives value for number of columns of data to be entered
lastcol3 = ws3.Cells(4, ws3.Columns.Count).End(xlToLeft).Column - 1
'Defines 2 dimensional array
ReDim arr(1 To numRows, 1 To lastcol3)
'creates array from list of classes
classArray = ws3.Range(ws3.Cells(4, 2), ws3.Cells(4, lastcol3 + 1))
'AUTO
Application.Calculation = xlCalculationAutomatic
For r = 1 To lastcol3
'Makes value in D1 in Class calculation sheet equal to the Class name
ws1.Range("D1") = classArray(1, r)
'MANUAL
Application.Calculation = xlCalculationManual
For i = 1 To numRows
'creates array of column of Data sizes
arr(i, r) = ws1.Cells(6 + i, 11)
Next
'AUTO
Application.Calculation = xlCalculationAutomatic
Next
'MANUAL
Application.Calculation = xlCalculationManual
For k = 1 To lastcol3
For j = 1 To numRows
If arr(j, k) = 15 Then
ws2.Cells(6 + j, 4) = 1 + ws2.Cells(6 + j, 4)
ElseIf arr(j, k) = 28 Then
ws2.Cells(6 + j, 5) = 1 + ws2.Cells(6 + j, 5)
ElseIf arr(j, k) = 50 Then
ws2.Cells(6 + j, 6) = 1 + ws2.Cells(6 + j, 6)
End If
Next
Next
'AUTO
Application.Calculation = xlCalculationAutomatic
'Speed
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
ApplicationEnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Sub