I am trying to write a function in VBA that computes a time-weighted average, but the #VALUE!
error appears when I try to use the function in my worksheet.
While trying to debug I have been able to validate my approach to change CurRPM
by iterating CurOffset
and using CurRng = rng.Offset(CurOffset, 0)
. The effect of changing CurRng
is to iterate down the RPM column, checking if the cell under CurRng
is either empty, the same as CurRPM
, or non-empty and different from CurRPM
.
Public Function TIMEAVERAGE(rng As Range) As Long
'Initializing Variables
Dim CurTime As Integer
Dim CurRPM As Integer
Dim CurSum As Integer
Dim CurOffset As Integer
CurOffset = 0
CurSum = 0
'The input cell is the first RPM
'The cell to the left of the input cell is the second RPM
CurTime = rng.Offset(0, -1)
CurRPM = rng
'Keep calculating as long as the cell below CurRng isn't empty
While IsEmpty(CurRng.Offset(1, 0)) = False
'If the cell below has the same RPM, look at next cell
If CurRng.Offset(1, 0) = CurRPM Then
CurOffset = CurOffset + 1
CurRng = rng.Offset(CurOffset, 0)
Else:
'Otherwise, add the previous RPM's contribution to the average
'CurTime, as shown, is the start of the previous RPM
CurSum = CurSum + CurRPM * (CurRng.Offset(0, -1) - CurTime)
'Change CurRPM and CurTime for the new RPM
CurRPM = CurRng.Offset(1, 0)
CurTime = CurRng.Offset(0, -1)
CurOffset = CurOffset + 1
CurRng = rng.Offset(CurOffset, 0)
End If
Wend
'Add the contributions of the final RPM
CurSum = CurSum + CurRPM * (CurRng.Offset(0, -1) - CurTime)
'Return the final TIMEAVERAGE
TIMEAVERAGE = CurSum / CurRng.Offset(0, -1)
End Function
The desired result from this program is returning 150 if the user enters =TIMEAVERAGE(B2)
for the cells below. Instead, a #VALUE!
error is returned.
A B
________________
1| Time | RPM
2| 0 | 100
3| 1 | 100
4| 2 | 100
5| 3 | 200
6| 4 | 200
7| 5 | 200
8| 6 | 200