Calculate the average of cells in empty cells in a column

user_12608433 0
Viewed 46

The VBA code below calculates the Sum of cells above empty cells in a column in Excel. The number of rows preceding each empty cell in the column is in not the same. I want to adjust the code to calculate the average instead. A counter can be added and then divide the sum (which is already calculated) by the counter.

The original problem and the code (written by Bernard Liengme) are presented on the link below: https://answers.microsoft.com/en-us/msoffice/forum/all/automatically-calculate-the-sum-of-data-separated/a691afcf-683e-463f-bad7-9fa3a81cf48c

Thanks.

Sub tryme()
   lastRow = Cells(Rows.Count, "A").End(xlUp).Row
   For k = 1 To lastRow
    If Cells(k, "A") <> "" Then
      Subtotal = Subtotal + Cells(k, "B")
    Else
      Cells(k, "B") = Subtotal
      Subtotal = 0
    End If
   Next k
   Cells(lastRow + 1, "B") = Subtotal
End Sub
vba excel average
1 Answers

Add Subaverages

A Quick Fix

Option Explicit

Sub AddSubAVG()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve
    
    Dim LastRow As Long: LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim k As Long
    Dim tCount As Long
    Dim tSum As Double
    
    For k = 1 To LastRow
        If ws.Cells(k, "A").Value <> "" Then
            tSum = tSum + ws.Cells(k, "B").Value
            tCount = tCount + 1
        Else
            If tCount > 0 Then
                ws.Cells(k, "B").Value = tSum / tCount
                tSum = 0
                tCount = 0
            End If
        End If
    Next k
    
    If tCount > 0 Then ws.Cells(LastRow + 1, "B").Value = tSum / tCount

End Sub
user_98140690
Related