1
\$\begingroup\$

I have a VBA macro for a file of GPS data. It copies rows and subsequent rows to a new worksheet when the GPS data shows movement to the south.

It works fine, but is pretty slow on larger files (20,000 rows+). I'm looking for suggestions on how to speed it up.

The cell values in the macro are from another macro analyzing the GPS data. 1 means movement North, 2 means no movement, 3 means movement South. I could easily change these to different datatype if that would speed up this macro.

Sub SplitIntoGroups()

Application.ScreenUpdating = False

'The data is incomplete in the first 50 and last 50 rows, so this is so it doesn't analyze that data

Dim NearEnd As Integer
Dim NearStart As Integer
NearStart = 52
NearEnd = (Cells(Sheet1.Rows.Count, 3).End(xlUp).row) - 50

'Groups are the different sheets of data. I start with zero, because the first is usually unimportant

Dim Groups As Integer
Dim r As Integer

'GroupsCheck is the variable used to go through each row
Dim GroupsCheck As Integer

'WentNorth is a boolean to ensure there was movement to the north before creating a new sheet. 
Dim WentNorth As Boolean

Sheets.Add.Name = "Group 0"
Groups = 0
'r is used as the row offset, so each row can be copied on the next row in the proper worksheet
r = 0

For GroupsCheck = NearStart To NearEnd

    If Sheets("Sheet1").Cells(GroupsCheck, "AB").Value = 1 Then WentNorth = True
    End if
    r = r + 1

    'once north movement (WentNorth=true) exists, a new sheet will be created when south movement first occurs (cells = 3 and previous cell <3)
        If Sheets("Sheet1").Cells(GroupsCheck, "AB").Value = 3 And Sheets("Sheet1").Cells(GroupsCheck - 1, "AB").Value < 3 And WentNorth = True Then
                Groups = Groups + 1
                Sheets.Add.Name = "Group " & Groups

                'once a new sheet is created, r and WentNorth are reset
                r = 0
                WentNorth = False
        End If

    'the copying function
    Worksheets("Sheet1").Range("A" & GroupsCheck & ": AB" & GroupsCheck).Copy Worksheets("Group " & Groups).Range("A2:AE2").Offset(r, 0)
Next GroupsCheck

Application.ScreenUpdating = True


End Sub
\$\endgroup\$
0

2 Answers 2

0
\$\begingroup\$

Once I had an issue with huge number of rows and lot of comparisons between values. It involves using couple of loops through all data and was very slow. Solution was to move process from XL cells to memory. As you know xls file is structured as xml and your data is a minor part of this document. Every time you refer to the cell, XL engine goes through the whole file until reaches particular xml tag.

In my project I had firstly filled array variable with values, and then made loops on array, not on cells.

You could do this:

'initialize array
Dim arr(0 to 25000) 'Set your real upper bound 
For i = LBound(arr) to UBound(arr)
    arr(i)  = Sheets("Sheet1").Cells(NearStart + i, "AB")
Next i
...
'your code using array
For GroupsCheck = LBound(arr) to UBound(arr)
    if arr(GroupsCheck) = 3 Then...
...

TIP: Even if you loop through the cells, avoid using same cell reference multiple times in one loop like Sheets("Sheet1").Cells(GroupsCheck, "AB").Value Every reference forces XL to find this value again and again. Better assign it to variable at the begin of loop. Also you can get value of previous row by second variable, not by referencing cell.

varCell = 0
for m to n
    prevCell= varCell
    varCell = Sheets("Sheet1").Cells(GroupsCheck, "AB").Value
    if varCell = 3 then...
    ...
    if (varCell = 3) and (prevCell<3) and WentNorth...

Allocating this variable in memory is MUCH faster then in worksheet.

\$\endgroup\$
3
  • \$\begingroup\$ Thanks for the array idea. I implemented it and it works fine. Unfortunately, the time to run the macro is pretty similar, so I guess the copy and paste operation is the main factor slowing it down. Any thoughts? Could a two dimensional array (holding all the data) work? \$\endgroup\$
    – gkavet
    Commented Nov 16, 2017 at 19:08
  • \$\begingroup\$ You could try to minimize reading from xl as it possible. So, try organize output data in virtual structures - arrays, vars etc. After create new sheets with printing data to them. I assume that sheet creation slows most if them are too much, because of specific of xl file structure. \$\endgroup\$
    – Vmesser
    Commented Nov 16, 2017 at 19:24
  • \$\begingroup\$ I just switched from the copy command to making new sheet values equal to the values in the old sheet. It's really fast now. Thanks for the help. \$\endgroup\$
    – gkavet
    Commented Nov 16, 2017 at 20:10
0
\$\begingroup\$

20,000+ is pretty close to 32,767, so first thing is to declare NearEnd As Long. Actually, you can declare all variables used as row numbers as Long, there is no gain on performance when you use Integer, and you are less prone to have overflow error. Secondly, the issue with Worksheets("Group " & Groups).Range("A2:AE2").Offset(r, 0) line. As mentioned in comments above, it should be either continuation sing in line above "(space)_" or .pastespecial on the end. And third, you could make code running faster just by replacing For-Next loop with the Object Loop. So, define range:

With Sheets("Sheet1")
    Set rng = Range(.Range(NearStart, "AB"), .Range(NearEnd, "AB"))
End With

and then

For Each cl in rng
(....)
Next cl

rng and cl declared as Range, of course.

If you have formulas and they don't need to be calculated while macro is running, I should turn of automatic calculation, together with screen flickering. You probably know this, just for the record:

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationmanual
End With

and back to xlCalculationAutomatic on the end.

\$\endgroup\$
1
  • \$\begingroup\$ Thanks for the info on integer vs long speed. On the object loop, I get an error with the Set range line. Any idea what's wrong. Also, not sure the best way to look at the previous cl:AB value (to see if <3) in the for/next cl loop. \$\endgroup\$
    – gkavet
    Commented Nov 14, 2017 at 20:30

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.