VBA Script to Extract data every 30s Interval - excel

Question

I have a list of voltage outputs and the time stamps at which they were recorded. For some background, my test increments a voltage by 1mV every 30s from 0 - 5V. The system reads every second or so, it can be inconsistent. The sheet has over 70000 rows but I only need just over 5000.
So far I have used =RIGHT(TEXT(A1, "hh:mm:ss"),2) to extract the seconds from the time. Unfortunately, the timestamps are always perfectly every 30s so I can't simply filter for every 0s and 30s. Sometimes 30s is skipped and it reads at say 35s.
How would I create a VBA script that extracts the increments at every 30s interval and if there is no perfect 30s jump, select the closest match to it (i.e. 29 or 31)?
Any guidance would be greatly appreciated!

Answer 1

OK, I think that the following will work. Note that this needs to be entered as an Excel formula array in the Flags output column, with the function's input parameter being the corresponding column that contains the times. (So the output column's formula should look like: {=FlagEvery30Sec(D2:D36)})
' Returns 1 if the corresponding row should be used, and 0 otherwise
Public Function FlagEvery30Sec(SourceTimes As Range) As Integer()
Dim Times() As Variant
Dim Flags() As Long
' get the source values
Times = SourceTimes
' set the output values array to the same size
Dim First As Long, Last As Long
First = LBound(Times, 1)
Last = UBound(Times, 1)
ReDim Flags(First To Last, 1 To 1)
Dim curr As Long, prev As Long
prev = First
curr = First
Flags(curr, 1) = 1
curr = curr + 1
Dim currTime As Date
Dim currSecs As Double, prevSecs As Double, lastFlagSecs As Double
lastFlagSecs = CDbl(Times(curr, 1)) * 24 * 60 * 60
While curr <= Last
Flags(curr, 1) = 0 ' assume not flagged, change later
currSecs = CDbl(Times(curr, 1)) * 24 * 60 * 60
If (currSecs - lastFlagSecs) >= 30 Then
If ((currSecs - lastFlagSecs) - 30) <= (30 - (prevSecs - lastFlagSecs)) Then
Flags(curr, 1) = 1
lastFlagSecs = currSecs
Else
Flags(prev, 1) = 1
lastFlagSecs = prevSecs
End If
End If
prevSecs = currSecs
prev = curr
curr = curr + 1
Wend
FlagEvery30Sec = Flags
End Function
Note that there are basically two approaches to this:
Take the first timestamp, mark off every 30 seconds, then find the entry that is closest to each mark and flag it. Or,
Take the first timestamp and find the following entry that is closest to 30 seconds after it. Then take that entry's time as the base timestamp and find the next entry that is closest to 30 seconds after that. Repeat this until you reach the end.
My function above uses the second method. You should note that this can drift though and the final result may be more or less marks than TotalSeconds/30.