Hourly Data Parser
Jump to navigation
Jump to search
This utility is useful to taking data logged at more than once per hour and down sampling to return just hourly. For example, taking 5 minute snow data after a moving average has been applied and just grabbing the hourly values from the moving average.
Option Explicit
Public Sub hourlysample()
Dim datecol As Integer
Dim inputcol As Integer
Dim outcol As Integer
Dim inputworksheetz As Integer
Dim outputworksheetz As Integer
Dim startrow As Long
Dim outputdate As Boolean
Dim columnincr As Integer
Dim startcol As Integer
' stuff that should be set just initially
datecol = 1
inputworksheetz = 1
outputworksheetz = 2
startrow = 5
startcol = 9
inputcol = startcol
outcol = 1
outputdate = True
Call smp_column(datecol, inputcol, outcol, inputworksheetz, outputworksheetz, startrow, outputdate)
outputdate = False
For columnincr = 1 To 3
inputcol = startcol + columnincr
outcol = 2 + columnincr
Call smp_column(datecol, inputcol, outcol, inputworksheetz, outputworksheetz, startrow, outputdate)
Next
End Sub
Public Sub smp_column(datecol As Integer, inputcol As Integer, outcol As Integer, inputworksheetz As Integer, outputworksheetz As Integer, startrow As Long, outputdate As Boolean)
Dim row As Long
Dim thetime
Dim curdata As Double
Dim outrow As Integer
outrow = startrow
row = startrow
worksheets(outputworksheetz).cells(row - 1, outcol).value = worksheets(inputworksheetz).cells(2, inputcol).value
Do While worksheets(inputworksheetz).cells(row, datecol).value <> ""
thetime = Int(right(format(worksheets(inputworksheetz).cells(row, datecol).value, "hh:mm"), 2))
curdata = worksheets(inputworksheetz).cells(row, inputcol).value
If thetime = 0 Then
' top of the hour, sample the point
' new hour, do some outputting
If outputdate = True Then
' output the day
worksheets(outputworksheetz).cells(outrow, outcol).value = worksheets(inputworksheetz).cells(row, datecol).value
worksheets(outputworksheetz).cells(outrow, outcol + 1).value = curdata
Else:
worksheets(outputworksheetz).cells(outrow, outcol).value = curdata
End If
outrow = outrow + 1
End If
row = row + 1
Loop
End Sub