Public Type udtXYFunction
xySlope As Double
xyConstant As Double
xyY As Double
xyX As Double
End Type
Sub funcLER()
Dim LastRow, StartRow, EndRow As Integer
Dim CurrentElevation, StartElevation, LastElevation, _
EndElevation, RatioElevation As Double
Dim coorX1, coorX2, coorY1, coorY2 As Double
Dim TotalDistance, RatioDistance As Double
Dim intersectX As Double
Dim Slope As Double
Dim Constant As Double
Dim SlopePerpendicular, ConstantPerpendicular, _
PerpendicularX, PerpendicularY As Double
'Find last row with data
LastRow = Cells(65536, 1).End(xlUp).Row
'Starting Elevation
StartElevation = Cells(1, 3).Value
'Ending Elevation
LastElevation = Cells(LastRow, 3).Value
StartRow = 1
For i = 2 To LastRow
CurrentElevation = Cells(i, 3).Value
If Cells(i, 3).Value <> 0 Then
EndElevation = CurrentElevation
EndRow = Cells(i, 3).Row
Cells(i, 3).Font.Bold = True
If EndRow - StartRow = 1 Then
StartRow = EndRow
StartElevation = EndElevation
Else
For h = StartRow + 1 To EndRow - 1
'Elevation Difference
ElevationDiff = EndElevation - StartElevation
'Total Length
TotalDistance = CalcDistance(Cells(StartRow, 1), Cells(i, 1), Cells(StartRow, 2), Cells(i, 2))
'Slope & Constant for Start-to-End function, i.e. y(x)
Slope = CalcXYFunction(Cells(StartRow, 1), Cells(EndRow, 1), Cells(StartRow, 2), Cells(EndRow, 2)).xySlope
Constant = CalcXYFunction(Cells(StartRow, 1), Cells(EndRow, 1), Cells(StartRow, 2), Cells(EndRow, 2)).xyConstant
'Slope for a perpendicular line, i.e. y2(x)
SlopePerpendicular = -1 / Slope
ConstantPerpendiclar = Cells(h, 2) + (SlopePerpendicular * Cells(h, 1))
'Find intersection point
intersectX = (ConstantPerpendicular - Constant) / (Slope + SlopePerpendicular)
intersectY = XYFunction(0, intersectX, Slope, Constant).xyY
Next h
StartRow = EndRow
StartElevation = EndElevation
End If
End If
Next i
End Sub
Function CalcDistance(X1 As Double, X2 As Double, Y1 As Double, Y2 As Double) As Double
Dim B, C As Double
B = (X1 - X2) ^ 2
C = (Y1 - Y2) ^ 2
CalcDistance = Sqr(B + C)
End Function
Function CalcXYFunction(X1 As Double, X2 As Double, Y1 As Double, Y2 As Double) As udtXYFunction
CalcXYFunction.xySlope = (Y2 - Y1) / (X2 - X1)
CalcXYFunction.xyConstant = Y1 - (CalcXYFunction.xySlope * X1)
End Function
Function XYFunction(Y As Double, X As Double, Slope As Double, Constant As Double) As udtXYFunction
XYFunction.xyY = (Slope * X) + Constant
XYFunction.xyX = (Y - Constant) / Slope
End Function
I keep running into a problem using the function XYFunction when the function inputs are calculated using other functions.