How to calculate daily averages in VBA

[wwj]

How to calculate daily average
- Silicon mine project.

1. Missing Reference to the Scripting Runtime Library
The CreateObject("Scripting.Dictionary") creates a dictionary object, but VBA sometimes requires a reference to the Microsoft Scripting Runtime library for proper handling.
Without this reference, VBA might fail when you attempt to loop through dict.Keys.

Solution:
Open the VBA editor (Alt + F11).
Go to Tools > References.
Look for Microsoft Scripting Runtime in the list and check it.
Click OK to save.

Code: Select all

Sub calculate_daily_average_head()
'
'   Calculate daily average heads.
'
    Dim inSht  As String
    Dim outSht  As String
    Dim wsIn  As Worksheet
    Dim wsOut  As Worksheet
    
    Dim dict As Object
    Dim cell As Range
    Dim dateKey As Variant  ' check "Microsoft Scripting Runtime" in Tools > References.
    Dim dailySum As Double
    Dim dailyCount As Long
    Dim lastRow As Long
    Dim i As Long
    Dim j As Long
    
    ThisWorkbook.Activate
    
    inSht = "FormedData"
    outSht = "FormedAvgHead"
    
    ' Set input and output sheets
    Set wsIn = ThisWorkbook.Sheets(inSht)
    Set wsOut = ThisWorkbook.Sheets(outSht)
    
    ' Clear target sheet
    wsOut.Cells.Clear
    
    maxCol = Sheets(inSht).Cells(2, Columns.Count).End(xlToLeft).Column
    
    For j = 1 To maxCol Step 2
        wsOut.Cells(1, j) = wsIn.Cells(1, j)
        wsOut.Cells(2, j) = wsIn.Cells(2, j)
        wsOut.Cells(2, j + 1) = wsIn.Cells(2, j)
        
        lastRow = Sheets(inSht).Cells(Rows.Count, j).End(xlUp).Row
        
        ' Create a dictionary to store daily data
        Set dict = CreateObject("Scripting.Dictionary")
        
        ' Loop through the source data to aggregate scores by date
        For i = 3 To lastRow ' Start from row 3, assuming headers in row 1-2
            dateKey = Int(wsIn.Cells(i, j).Value) ' Extract the date (ignore time)
            
            If Not dict.exists(dateKey) Then
                dict.Add dateKey, Array(0, 0) ' Initialize with sum = 0, count = 0
            End If
            
            dailySum = dict(dateKey)(0) + wsIn.Cells(i, j).Value
            dailyCount = dict(dateKey)(1) + 1
            dict(dateKey) = Array(dailySum, dailyCount)
        Next i
        
        ' Write the daily averages to the target sheet
        i = 3
        For Each dateKey In dict.Keys
            wsOut.Cells(i, j).Value = dateKey
            wsOut.Cells(i, j).NumberFormat = "mm/dd/yyyy"
            wsOut.Cells(i, j + 1).Value = dict(dateKey)(0) / dict(dateKey)(1) ' Average
            wsOut.Cells(i, j + 1).NumberFormat = "0.00"
            i = i + 1
        Next dateKey
     
    Next j
    
    MsgBox "Done!"
    
End Sub