Assigning entire column of data to specific column of an array in VBA

Question

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

• Hatrnd: It is not possible in VBA to partially populate arrays with columns, rows or blocks of any kind. You must loop through every element.

Answer 1

First things first, your variables. The names aren't great. For the ws1 to ws3 you're using numbers, which should tell you it's not specific enough or you aren't being effective with your variables.

Worksheets have a CodeName property - View Properties window (F4) and the (Name) field can be used as the worksheet name. This way you can avoid Sheets("Data") and instead just use Data.

Also lastcol3 - what's that? lastColumn? Why the 3, also you missed camelCase on that one. Standard VBA naming conventions have camelCase for local variables and PascalCase for other variables and names. You could just call it resultsLastColumn instead.

i,r,j,k - these are counters right?

r - currentColumn. i,j,k are acceptable, but personal preference I like to avoid those.

Dim arr - When you don't define your variable, VBA will declare it as a Variant, which are objects:

Performance. A variable you declare with the Object type is flexible enough to contain a reference to any object. However, when you invoke a method or property on such a variable, you always incur late binding (at run time). To force early binding (at compile time) and better performance, declare the variable with a specific class name, or cast it to the specific data type.

By not declaring variables, you could possibly be paying a penalty.

In this case, it is a variant, but it's good to note for the future. It should have a more descriptive name, though.

lastColumn and numRows are integers - Integers - integers are obsolete. According to msdn VBA silently converts all integers to long.

Additionally, your numRows is set to 1000 and never changed. Why not

Const NUMBER_OF_ROWS As Long = 1000

Your indenting is non-existent. It's good practice to indent all of your code that way Labels will stick out as obvious.

Always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know. In this case your variable wb isn't defined.

---

You use Application.Calculation a lot. You set it to Manual and do some stuff, then set it to Automatic. Then you loop up to 5000 times in your r loop turning it manual and back to automatic. None of that is needed. The calculations you're doing in VBA aren't affected by the worksheet calculation. I don't know what kind of resources that's using, but I can't imagine it's helping.

---

Comments - "code tell you how, comments tell you why". The code should speak for itself, if it needs a comment, it might need to be made more clear. If not, the comment should describe why you're doing something rather than how you're doing it. Here are a few reasons to avoid comments all together.

---

ActiveSheet.DisplayPageBreaks = False - this will only work on the active sheet, what if the sheet isn't active. Why not tell it which sheet to do it on?

Also your last Application.EnableEvents is missing the ..

---

I don't quite understand this line

ws1.Range("D1") = classArray(1, r)

Does this need to move down column D with the class names?

---

With your arr array

ReDim arr(1 To NUMBER_OF_ROWS, 1 To resultsLastColumn)
For r = 1 To resultsLastColumn
 ws1.Range("D1") = classArray(1, r)
 For i = 1 To NUMBER_OF_ROWS
 arr(i, r) = ws1.Cells(6 + i, 11)
 Next
Next
For k = 1 To resultsLastColumn
 For j = 1 To NUMBER_OF_ROWS
 If arr(j, k) = 15 Then
 ThisWorkbook.Data.Cells(6 + j, 4) = 1 + ThisWorkbook.Data.Cells(6 + j, 4)
 ElseIf arr(j, k) = 28 Then
 ThisWorkbook.Data.Cells(6 + j, 5) = 1 + ThisWorkbook.Data.Cells(6 + j, 5)
 ElseIf arr(j, k) = 50 Then
 ThisWorkbook.Data.Cells(6 + j, 6) = 1 + ThisWorkbook.Data.Cells(6 + j, 6)
 End If
 Next
Next

This is pretty inefficient. Why not just pull everything into the array and do the sorting in it, rather than on the sheet. That will be quicker.

arr = Data.Range(Cells(1, 6), Cells(NUMBER_OF_ROWS, resultsLastColumn))

Now you can loop with your j and k in the arr or just eliminate k and reuse i.

---

So at the very least, you'll have this

Option Explicit
Private Sub UpdateData()
 Application.ScreenUpdating = False
 Application.DisplayStatusBar = False
 Application.EnableEvents = False
 ActiveSheet.DisplayPageBreaks = False
 Application.Calculation = xlCalculationManual
 Const NUMBER_OF_ROWS As Long = 1000
 Dim resultsLastColumn As Integer
 Dim classArray As Variant
 Dim i As Long
 Dim j As Long
 Dim k As Long
 Dim arr As Variant
 resultsLastColumn = Results.Cells(4, Results.Columns.Count).End(xlToLeft).Column - 1
 ReDim arr(1 To NUMBER_OF_ROWS, 1 To resultsLastColumn)
 classArray = Results.Range(Results.Cells(4, 2), Results.Cells(4, resultsLastColumn + 1))
 ClassCalculationSheet.Range("D1:D" & resultsLastColumn) = classArray()
 arr = Data.Range(Cells(1, 6), Cells(NUMBER_OF_ROWS, resultsLastColumn))
 For j = 1 To resultsLastColumn
 For i = 1 To NUMBER_OF_ROWS
 If arr(i, j) = 15 Then
 Data.Cells(6 + j, 4) = 1 + Data.Cells(6 + i, 4)
 ElseIf arr(i, j) = 28 Then
 Data.Cells(6 + j, 5) = 1 + Data.Cells(6 + i, 5)
 ElseIf arr(i, j) = 50 Then
 Data.Cells(6 + j, 6) = 1 + Data.Cells(6 + i, 6)
 End If
 Next
 Next
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 Application.DisplayStatusBar = True
 Application.EnableEvents = True
 ActiveSheet.DisplayPageBreaks = True
End Sub

Some tweaking might be needed as I can't run the macro to see what needs adjusting.

Answer 2

What Raystafarian has answered is all true, however I see the most time wasting unaddressed:

you're doing large number of calculations on the worksheet

To solve it you need to use another array, e.g. NewArray, load the data into it the same way as you did for Arr, perform the calculations there, then you can just load the data back to the sheet: Data.Range(...)=NewArray

---

Also, working always with 1000 rows doesn't seem to be the best idea, instead you can use NumRows=ws.UsedRange.Rows.Count

• Raystafarian: Is that what the second loop is doing? Calculations on the sheet? No wonder all the application.calculates
• Máté Juhász: @Raystafarian: I mean all the ws2.cells (..)=1+ws2.cells (..). It's really inefficient! He should do all those on an array, nor directly on the sheet.