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.

• Kaz: Whenever your code deals with spreadsheet data, it's Really useful to have a screenshot (obfuscated if necessary) to work from as well.
• theotheraussie: @Zak I did you one better, I added a link to the cut down version of the spreadsheet.
• Kaz: That's Awesome.

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.