Daily Averages 2

Copy and paste the text in the box into the visual basic editor that comes with Excel. To get access to personal.xls in the visual basic editor check out this article: Save Macros in Excel

This macro and collection of subroutines creates daily averages from hourly data. It's a pretty general one. I used it originally with soil temperature strings where there are several columns of data that need to be changed from hourly to daily. So, there are a couple flags to assist with this. You can report the day if you'd like and also the number of samples in the 'daily' average for example. The first subroutine you can use to call the second one which does all the work for you.

Any questions check with Bob.

Option Explicit
Public Sub daily_avg()
  Dim daycol As Integer
  Dim inputcol As Integer
  Dim outcol As Integer
  Dim worksheetz As Integer
  Dim startrow As Long
  Dim outputday As Boolean
  Dim outputcount As Boolean
  Dim columnincr As Integer
  
  ' stuff that should be set just initially
  daycol = 1
  worksheetz = 9
  startrow = 32
  outputcount = False
  outputday = True
  inputcol = 3
  outcol = 16
  Call avg_column(daycol, inputcol, outcol, worksheetz, startrow, outputday, outputcount)
  outputday = False
  For columnincr = 0 To 10
    inputcol = 4 + columnincr
    outcol = 18 + columnincr
    Call avg_column(daycol, inputcol, outcol, worksheetz, startrow, outputday, outputcount)
  Next
End Sub

Public Sub avg_column(daycol As Integer, inputcol As Integer, outcol As Integer, worksheetz As Integer, startrow As Long, outputday As Boolean,  outputcount As Boolean)
  Dim row As Long
  Dim count As Integer
  Dim theday As Integer
  Dim curdata As Double
  Dim daysum As Double
  Dim outrow As Integer
  
  outrow = startrow
  row = startrow
 
  theday = Int(Worksheets(worksheetz).Cells(row, daycol).Value)
  curdata = Worksheets(worksheetz).Cells(row, inputcol).Value
  If Abs(curdata) < 6999 Then
    daysum = curdata
    count = 1
  End If
  row = row + 1
  Do While Worksheets(worksheetz).Cells(row, daycol).Value <> ""
    If theday = Int(Worksheets(worksheetz).Cells(row, daycol).Value) Then
      ' same day
      curdata = Worksheets(worksheetz).Cells(row, inputcol).Value
      If Abs(curdata) < 6999 Then
        daysum = daysum + curdata
        count = count + 1
      End If
    Else:
      ' new day, do some outputting
      If outputday = True Then
        ' output the day
        Worksheets(worksheetz).Cells(outrow, outcol).Value = theday
        If count > 0 Then
          ' output daily average
          Worksheets(worksheetz).Cells(outrow, outcol + 1).Value = daysum / count
        End If
        If outputcount = True Then
          ' output the count if the boolean is true
          Worksheets(worksheetz).Cells(outrow, outcol + 2).Value = count
        End If
      Else:
        ' don't output the day
        If count > 0 Then
          ' output daily average
          Worksheets(worksheetz).Cells(outrow, outcol).Value = daysum / count
        End If
        If outputcount = True Then
          ' output the count if the boolean is true
          Worksheets(worksheetz).Cells(outrow, outcol + 1).Value = count
        End If
      End If
      outrow = outrow + 1
      ' okay, done outputting.  Now to ingest the new data as before.
      ' first reset the vars.
      count = 0
      daysum = 0
      theday = Int(Worksheets(worksheetz).Cells(row, daycol).Value)
      curdata = Worksheets(worksheetz).Cells(row, inputcol).Value
      If Abs(curdata) < 6999 Then
        daysum = curdata
        count = 1
      End If
      
    End If     
    row = row + 1
  Loop
    ' drop in the stuff for the last day of year.
    ' new day, do some outputting
    If outputday = True Then
     ' output the day
     Worksheets(worksheetz).Cells(outrow, outcol).Value = theday
     If count > 0 Then
       ' output daily average
       Worksheets(worksheetz).Cells(outrow, outcol + 1).Value = daysum / count
     End If
     If outputcount = True Then
       ' output the count if the boolean is true
       Worksheets(worksheetz).Cells(outrow, outcol + 2).Value = count
     End If
   Else:
     ' don't output the day
     If count > 0 Then
       ' output daily average
       Worksheets(worksheetz).Cells(outrow, outcol).Value = daysum / count
     End If
     If outputcount = True Then
       ' output the count if the boolean is true
       Worksheets(worksheetz).Cells(outrow, outcol + 1).Value = count
     End If
   End If
 End Sub