2
\$\begingroup\$

I'm trying to convert a data set that is split into two rows into a single row. This was my solution.

Public Sub Convert()
    Dim a, b, c, d, e, f, i As Integer
    Sheets("UASHEET").Cells.Clear
    a = Application.WorksheetFunction.CountIf(Worksheets("DATA").Range("I1:I15000"), "*/*")
    'Find how many time iterations there are
    i = Application.WorksheetFunction.Match("*/*", Worksheets("DATA").Range("i6:i500"), 0)
    i = (i - 12) / 2             'how many vertical slices model has
    d = 5                        'row position of the first time iteration
    b = 2                        'output row counter
    c = 0                        'row counter for input
    e = 11                       'how many rows should start from the time location in the input
    f = 0                        'time counter for input
    Do While f <> a
        f = f + 1
        Do While c <> i
            Worksheets("UASHEET").Cells(b, 1) = Worksheets("DATA").Cells(d, 9)
            Worksheets("DATA").Range("A" & d + e, "h" & d + e).Copy Destination:= _
                 Worksheets("UASHEET").Range("b" & b, "i" & b)
            e = e + 1
            Worksheets("DATA").Range("A" & d + e, "B" & d + e).Copy Destination:= _
                 Worksheets("UASHEET").Range("J" & b, "K" & b)
            c = c + 1
            e = e + 1
            b = b + 1
        Loop
        d = d + ((i * 2) + 12)
        c = 0
        e = 11
    Loop
End Sub

It runs, but it takes about 1 minute to run through about 10,000 rows. Is there any way to make this faster?

Here's the data : http://www.meteo.psu.edu/bufkit/data/NAM/12/nam_ksps.buf (Imported with space delimiter)

Basically trying to combine the TIME = with every row below it into a single row to make a table.

\$\endgroup\$
1
  • \$\begingroup\$ From the data, it looks like your main issue is with the rows of values for the ten parameters (PRES, TMPC, TMWC, etc.). Is that accurate? Also, what will you eventually do with the data? For example, will each dataset be analyzed separately? Your parsing above seems to be the first step in a longer process. \$\endgroup\$
    – PeterT
    Mar 29, 2022 at 21:25

1 Answer 1

2
\$\begingroup\$

It is always a speed improvement to set variables external to a loop so long as the value is remains constant within the loop. So, the first change to improve performance here would be:

Prefer instantiating Worksheet objects to repeatedly accessing the Worksheets collection.

Example:

Replace

Worksheets("UASHEET") 

With

Dim uaSheet As Worksheet
set uaSheet = Worksheets("UASHEET")

Prefer setting large Ranges from arrays rather than Cell by Cell assignments from another Range

The code copies values one by one from the "DATASHEET" to the "UASHEET". It will be much faster to load an array of values that are subsequently copied to the target Range in a single operation. This is demonstrated in the code at the end of this answer.

Getting there from here

One useful aphorism regarding development is: "Make it work, Make it right, and Make it fast" (Kent Beck)

Since the code generates correct output, it meets the first criteria. The question asked is in regards to the last criteria. Unfortunately, it becomes a far more difficult process if the "make it right" criteria is skipped. So, what does it mean to "Make it right". To be honest, it is a highly subjective goal. That said, I found the code as written a bit difficult to understand. So, part of "making it right" would include improving its read-ability so that opportunities for "making it fast" can be recognized.

Developers spend far more time reading code than writing code. This reality is the motivation behind a number of best practices that may not necessarily result in faster execution, but will improve the speed at which the code can be understood.

Making it Right - Some best/better practices to make the code easier to understand.

Prefer meaningful variable names to a Comment about an un-meaningful variable name.

There is no performance gain (or loss) by using single character variable names...but there is an immense readability penalty. Consider the speed of understanding what the following two lines of code might mean:

a = w * h
areaOfRectangle = width * height

Regarding the posted code.

Example: Replace

    Dim a, b, c, d, e, f, i As Integer
    '...
    i = (i - 12) / 2             'how many vertical slices model has
    d = 5                        'row position of the first time iteration
    b = 2                        'output row counter
    c = 0                        'row counter for input
    e = 11                       'how many rows should start from the time location in the input
    f = 0                        'time counter for input    

With

Dim elementsToProcess As Long 'was a
Dim outputRow As Long 'was b
Dim inputRow As Long   'was c
Dim rowOfFirstIteration As Long 'was d
Dim timeLocationOffset As Long 'was e
Dim inputTimeCounter As Long 'was f
Dim totalIterations As Integer 'was i

Notes:

  1. In VBA Dim a, b, c, d, e, f, i As Integer only declares "i" as an Integer. All the other variables are implicitly declared as Variant types. Declaring one variable per line helps to avoid this common mistake.
  2. Prefer using Long to Integer See https://stackoverflow.com/questions/26409117/why-use-integer-instead-of-long

Prefer calling a Function to a Comment about a complicated calculation or a sequence of related/dependent calculations.

Example:

Replace

    'Find how many time iterations there are
    i = Application.WorksheetFunction.Match("*/*", Worksheets("DATA").Range("i6:i500"), 0)
    i = (i - 12) / 2             'how many vertical slices model has

With

    totalIterations = DetermineModelVerticalSliceCount(dataSheet)

Prefer For Next to Do While when using loops controlled by a simple counter

Do While is typically used when a For Next loop is not applicable. In this case, each Do While loop is simply incrementing a variable and comparing it to a maximum value (which is what a For Next loop does without having to explicitly increment the counter). That said, Do While logically works fine in this context. And, there is no performance change by using For Next rather than Do While.

Don't Repeat Yourself (DRY) principle: You can find out more here

DRY typically encourages the replacement of repeated expressions with a single, equivalent function,variable, or constant (e.g., Using variable uaSheet in preference to Worksheets("UASHEET"). Within the loops d + e is used 4 times - buried within lengthy range address expressions. It is not only repeated code, but it is difficult to understand what the sum represents (aside from a row) without piecing together declaration and comment information elsewhere in the procedure.

Returning to Performance

To assist finding performance gains using arrays rather than Cell by Cell assignments, I refactored the original code employing the items described above. With the better names and DRY applied it became a bit easier to see what was going on.

Within the loops, there are 3 times that data is written to "UASHEET". The process to improve performance would be to capture the data ("DATA" worksheet content) within 3 distinct arrays that can then be assigned, in bulk, to the appropriate targets of the "UASHEET" worksheet.

The total number of output rows for each array looks like it is equal to elementsToProcess * (totalIterations + 1).

So, create 3 arrays of this size once elementsToProcess and totalIterations are known. The code below is the result of the above refactoring ideas as well as implementing array-based transactions with Ranges. This code was not run against your data set, so there may be some debugging left to do - though I'm hoping not much.

Option Explicit

Public Sub Convert()
    
    Dim elementsToProcess As Long
    Dim inputRow As Long
    Dim rowOfFirstIteration As Long
    Dim timeLocationOffset As Long
    Dim inputTimeCounter As Long
    Dim totalIterations As Integer
    
    Dim dataSheet As Worksheet
    Set dataSheet = Worksheets("DATA")

    Dim uaSheet As Worksheet
    Set uaSheet = Worksheets("UASHEET")

    uaSheet.Cells.Clear
    elementsToProcess = Application.WorksheetFunction.CountIf(dataSheet.Range("I1:I15000"), "*/*")
    
    totalIterations = DetermineModelVerticalSliceCount(dataSheet)
    
    Dim arraySize_OneBased As Long
    arraySize_OneBased = elementsToProcess * (totalIterations + 1) + 1
    
    Dim uaSheetColumn1Array As Variant
    ReDim uaSheetColumn1Array(1 To arraySize_OneBased)
    
    Dim uaSheetBIColumnsArray As Variant
    '1 to 8 => uaSheet Columns "B" through "I", dataSheet Columns "A" thorugh "h"
    ReDim uaSheetBIColumnsArray(1 To arraySize_OneBased, 1 To 8)
    
    Dim uaSheetJKColumnsArray As Variant
    '1 to 2 => uaSheet Columns "J" through "K", dataSheet Columns "A" through "B"
    ReDim uaSheetJKColumnsArray(1 To arraySize_OneBased, 1 To 2)
    
    rowOfFirstIteration = 5
    
    Dim oneBasedArrayIndex As Long
    oneBasedArrayIndex = 1
    
    Dim rowOfInterest As Long
    For inputTimeCounter = 1 To elementsToProcess

        timeLocationOffset = 11
        For inputRow = 0 To totalIterations
        
            uaSheetColumn1Array(oneBasedArrayIndex) = dataSheet.Cells(rowOfFirstIteration, 9)
            
            rowOfInterest = rowOfFirstIteration + timeLocationOffset
            
            uaSheetBIColumnsArray(oneBasedArrayIndex) = dataSheet.Range("A" & rowOfInterest, "h" & rowOfInterest).Value
            
            timeLocationOffset = timeLocationOffset + 1
            rowOfInterest = rowOfFirstIteration + timeLocationOffset
            
            uaSheetJKColumnsArray(oneBasedArrayIndex) = dataSheet.Range("A" & rowOfInterest, "B" & rowOfInterest).Value
            
            timeLocationOffset = timeLocationOffset + 1
            
            oneBasedArrayIndex = oneBasedArrayIndex + 1
        Next
        
        rowOfFirstIteration = rowOfFirstIteration + ((totalIterations * 2) + 12)
    Next
    
    Dim lastRowOfOutput As String
    lastRowOfOutput = CStr(UBound(uaSheetColumn1Array, 1) + 1)
    
    uaSheet.Range("A2:A" & lastRowOfOutput).Value = uaSheetColumn1Array
    uaSheet.Range("B2:I" & lastRowOfOutput).Value = uaSheetBIColumnsArray
    uaSheet.Range("J2:K" & lastRowOfOutput).Value = uaSheetJKColumnsArray
    
End Sub

Private Function DetermineModelVerticalSliceCount(ByVal dataSheet As Worksheet) As Long
    Dim dResult As Long
    dResult = Application.WorksheetFunction.Match("*/*", dataSheet.Range("i6:i500"), 0)
    dResult = (dResult - 12) / 2
    DetermineModelVerticalSliceCount = dResult
End Function

\$\endgroup\$

Your Answer

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

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