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

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