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.