Interpolating data of multiple trains

Question

I have written a piece of VBA code to essentially replace a complex formula that I was using in the Excel cells.

I have the data on Sheet2, which describes multiple train journey's along the same track. the data is set out with each train journey after each other in an order of start time. The data consists of the train id's, location and speed at approximately 1 minute intervals.

I determine the number of trains, then determine the start and end index of each train so I restrict the searching to only the required range. These values are determined using some index, and matching functions in the cells, the values are just read from these cells. C4:XYZ4 and C5:XYZ5

I then search through the specified range to find the closest point to a predefined distance marker (sheet3, column A). This index is used to extract the distance and speed at successive locations and perform a simple linear interpolation at 50 metre intervals.

I had trouble trying to use loops when performing the search and match of the distance markers.

Private Sub CommandButton1_Click()

''
' Interpolate data in the Up direction.'
''
' This subroutine uses the existing information on the worksheet about the indiecies'
' of the corresponding train data to search for the desired distance marker. The routine'
' then performs a linear interpolation between successive points.'
''
' Note: The only real difference between the Up and Down interpolation is the Match type'
' in the match function (-1) for UP.'
''
    Dim a As Integer
    ' Declare the loop integers.'
    Dim startIndex As Long, endIndex As Long
    Dim loopIndex As Integer, searchRange As Integer
    Dim offset As Integer, endInterpolation As Long
    Dim lastCell As Range

    ' The number of trains to interpolate data for.'
    Dim numberOfTrains As Integer

    ' Declare the X and Y values for calculating the gradient and intercept.'
    Dim X1 As Double, X2 As Double
    Dim Y1 As Double, Y2 As Double

    ' Gradient and intercept placeholders.'
    Dim gradient As Double, yIntercept As Double
    ' Calculated speed placeholder.'
    Dim interpolatedSpeed As Double    

    ' Switch to manual calculation for faster processing.'
    Application.Calculation = xlCalculationManual    

    ' Determine the number of trains to interpolate the data for'
    numberOfTrains = WorksheetFunction.Count(Sheet2.Range("I:I"))
    offset = WorksheetFunction.Match("Distance", Sheet3.Range("A:A"), 0) + 1
    Set lastCell = Sheet3.Cells(Sheet3.Rows.Count, "A").End(xlUp)
    endInterpolation = lastCell.Row   

    ' Search through each train.'
    For searchRange = 1 To numberOfTrains

        ' Get the start and end indecies of each train.'
        startIndex = Sheet3.Cells(4, 2 + searchRange)
        endIndex = Sheet3.Cells(5, 2 + searchRange)      

        ' Loop through the data for interpolation.'
        For loopIndex = offset To endInterpolation

        ' Error Handler accounts for match function not finding the desired index, or a divide by zero error.'
        On Error GoTo ErrHandler:
            ' Get the closest distance values to the interpolated distance form the data.'
            X1 = WorksheetFunction.Index(Sheet2.Range("G" & startIndex, "G" & endIndex), _
                                    WorksheetFunction.Match(Sheet3.Range("A" & loopIndex), Sheet2.Range("G" & startIndex, "G" & endIndex), -1))
            X2 = WorksheetFunction.Index(Sheet2.Range("G" & startIndex, "G" & endIndex), _
                                    WorksheetFunction.Match(Sheet3.Range("A" & loopIndex), Sheet2.Range("G" & startIndex, "G" & endIndex), -1) + 1)
            ' Get the closest speed values for the corresponding distance values form the data.'

            Y1 = WorksheetFunction.Index(Sheet2.Range("H" & startIndex, "H" & endIndex), _
                                    WorksheetFunction.Match(Sheet3.Range("A" & loopIndex), Sheet2.Range("G" & startIndex, "G" & endIndex), -1))
            Y2 = WorksheetFunction.Index(Sheet2.Range("H" & startIndex, "H" & endIndex), _
                                    WorksheetFunction.Match(Sheet3.Range("A" & loopIndex), Sheet2.Range("G" & startIndex, "G" & endIndex), -1) + 1)

            ' Calculate the gradient and y-intercept.'
            gradient = (Y2 - Y1) / (X2 - X1)
            yIntercept = Y1 - gradient * X1

            ' Calculate the new interpolated speed.'
            interpolatedSpeed = gradient * Sheet3.Range("A" & loopIndex) + yIntercept

            ' Place the value in the desired cell.'
Result:
            Sheet3.Cells(loopIndex, 2 + searchRange) = interpolatedSpeed

        Next loopIndex   

    Next searchRange    

' If there is a zero in the data or a divide by zero error, replace the speed with 0.'
ErrHandler:
    If Err.Number <> 0 Then
        interpolatedSpeed = 0
        Resume Result:
    End If    

    ' Revert back to automatic calculation mode.'
    Application.Calculation = xlCalculationAutomatic

    ' Save the active workbook.'
    ActiveWorkbook.Save
End Sub

The code works fine as is, but I would like to find out if there was a better solution. The preferred solution will result in the least use of memory, as I would like to perform the interpolation on as much data as possible. The execution time is not that important as it only takes a minute or so and it wont be executed on a regular basis.

Here is a link to a redacted version of the excel file Data interpolation spreadsheet

The dates have been adjusted for privacy reasons.

Answer 1

The first thing I would do for speed is use arrays for the information you need. So in this case, we create a 10x4 array that has the locomotive, train, beginning row, ending row

Private Sub MainTrain()
    Dim numberOfTrains As Long
    numberOfTrains = Application.Count(Sheet2.Range("I:I"))
    Dim lastRow As Long
    lastRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
    Dim myTrains As Variant
    myTrains = TrainNames(numberOfTrains, lastRow)

    Dim myTrainRange As Variant
    myTrainRange = TrainRange(numberOfTrains, lastRow)

    Dim trainInformation As Variant
    ReDim trainInformation(1 To numberOfTrains, 1 To 4)

    Dim i
    For i = 1 To numberOfTrains
        trainInformation(i, 1) = myTrains(i, 1)
        trainInformation(i, 2) = myTrains(i, 2)
        trainInformation(i, 3) = myTrainRange(i, 1)
        trainInformation(i, 4) = myTrainRange(i, 2)
    Next

End Sub

Private Function TrainNames(ByVal numberOfTrains As Long, ByVal lastRow As Long) As Variant
    Dim myTrains As Variant
    ReDim myTrains(1 To numberOfTrains, 1 To 2)
    Dim trainIndex As Long
    trainIndex = 1
    Dim i As Long
    For i = 1 To lastRow
        If Sheet2.Cells(i, 9) = 1 Then
            myTrains(trainIndex, 1) = Sheet2.Cells(i, 1).Value
            myTrains(trainIndex, 2) = Sheet2.Cells(i, 2).Value
            If trainIndex = numberOfTrains Then Exit For
            trainIndex = trainIndex + 1
        End If
    Next
    TrainNames = myTrains
End Function

Private Function TrainRange(ByVal numberOfTrains As Long, ByVal lastRow As Long) As Variant
    Dim myTrains As Variant
    ReDim myTrains(1 To numberOfTrains, 1 To 2)
    Dim trainIndex As Long
    trainIndex = 1
    Dim i As Long
    For i = 1 To lastRow
        If Sheet2.Cells(i, 9) = 1 Then
            myTrains(trainIndex, 1) = i
            If trainIndex = numberOfTrains Then Exit For
            trainIndex = trainIndex + 1
        End If
    Next
    trainIndex = 1
    myTrains(1, 1) = 2
    For i = 1 To numberOfTrains - 1
        myTrains(i, 2) = myTrains(i + 1, 1) - 1
    Next
    myTrains(numberOfTrains, 2) = lastRow
    TrainRange = myTrains
End Function

I split it out into two functions, which means it's slower by needing to loop twice, but it's more clear what's happening. You can adjust as needed. Now you can use this array to lookup the information in the other sheet (hint: bring it into an array) to populate the interpolation.

Dim trainSchedule As Variant
trainSchedule = Sheet2.Range("A2:H" & lastRow)

By reading everything into arrays, you don't need to do anything on the sheet, which will be incredibly faster.

It also gets rid of those awful formulas on sheet3 finding the rows, if need be you can just use the trainInformation to print rows 4 through 7 on sheet3.

PopulateTrains trainInformation
Private Sub PopulateTrains(ByVal trainInformation As Variant)
    Dim i As Long
    For i = 1 To UBound(trainInformation)
        Sheet3.Cells(7, i + 2) = trainInformation(i, 1)
        Sheet3.Cells(6, i + 2) = trainInformation(i, 2)
        Sheet3.Cells(4, i + 2) = trainInformation(i, 3)
        Sheet3.Cells(5, i + 2) = trainInformation(i, 4)
    Next
End Sub

Now you need a function to populate your trainTable array by comparing the trains to the schedule.

---

As for reviewing your code, your structure looks pretty good and your variables are all declared with a type. Most of the variable names are good, but I wouldn't use offset because it's a system function and unclear. Looks like you adhere to Standard VBA naming conventions.

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

This piece of code is unnecessarily complex

Dim lastCell As Range
Set lastCell = Sheet3.Cells(Sheet3.Rows.Count, "A").End(xlUp)
endInterpolation = lastCell.Row

It's just

endInterpolation = Sheet3.Cells(Sheet3.Rows.Count,"A").End(xlup).Row

By adding the .Row at the end, it returns the row number.