Averaging a column of numbers with varying column length

EverettD
EverettD used Ask the Experts™
on
I need to average a column of numbers in a Table (of varying sizes) that contains data taken on various tests.  The number data points of each test may vary from case to case.  Data for different tests are separated by an empty row.  The relative position of the start point is known but the number of columns to include is not known beforehand.  This macro will run automatically based on a comparison of values in a different column as the data are accumulated.

Ideas?
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
There are ways depending on the situation. You should provide a sample which closely represents your problem for an appropriate solution.
NorieAnalyst Assistant

Commented:
Do you want an average for each test?
Try this Sub:

It takes whatever cell is active and assumes that it is the first row in the column.  

It then looks for the bottom row in the column and gives an average of the values in the column via messagebox.



Sub Averagecolumn()

Dim AveRange As Range
Dim LastRow As Long
Dim FRow As Long
Dim FColumn As Long

FRow = ActiveCell.Row
FColumn = ActiveCell.Column
LastRow = Cells(Rows.Count, FColumn).End(xlUp).Row

Set AveRange = Range(Cells(FRow, FColumn), Cells(LastRow, FColumn))
MsgBox Application.Average(AveRange)
Set AveRange = Nothing

End Sub

Open in new window

C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

Author

Commented:
Wow.  Works like a charm in my test case.  Should work just as well in the full script.

Thanks.
Everett

Author

Commented:
It turns out my test case is too simple.  In the real case there are data below the data of interest.  The sets of data are separated by an empty row.  

The solution above unfortunately does not recognize the empty row and goes all the way to the bottom.  

Can we get the average range to stop at the empty row?
As I said, you should post a sample showing what you want. Experts can go on guessing your scenario and may or may not hit the target.
Here is the updated code:

Sub Averagecolumn()

Dim AveRange As Range
Dim LastRow As Long
Dim FRow As Long
Dim FColumn As Long
Dim A As Integer

FRow = ActiveCell.Row
FColumn = ActiveCell.Column
LastRow = Cells(Rows.Count, FColumn).End(xlUp).Row

For A = FRow To LastRow
    If Cells(A, FColumn).Value = Empty Then
        LastRow = A - 1
        GoTo LRI
    End If
Next A

LRI:
Set AveRange = Range(Cells(FRow, FColumn), Cells(LastRow, FColumn))
MsgBox Application.Average(AveRange)
Set AveRange = Nothing

End Sub

Open in new window

Author

Commented:
Hope this file explains things a bit better than I did.
My scripts now used work for data sets of uniform size.


Thanks.
Example-case-for-experts.xlsx
Does this code block do what you need?


Sub Averagecolumn()

Dim AveRange As Range
Dim LastRow As Long
Dim FRow As Long
Dim FColumn As Long
Dim A As Integer

FRow = ActiveCell.Row
FColumn = ActiveCell.Column
LastRow = Cells(Rows.Count, FColumn).End(xlUp).Row

For A = FRow To LastRow
    If Cells(A, FColumn).Value = Empty Then
        LastRow = A - 1
        GoTo LRI
    End If
Next A

LRI:
Set AveRange = Range(Cells(FRow, FColumn), Cells(LastRow, FColumn))
MsgBox Application.Average(AveRange)
Set AveRange = Nothing

End Sub

Open in new window

This macro will insert the averages wherever it finds the word "Averages" in column F

Sub blockave()
Dim cel As Range
For Each cel In ActiveSheet.UsedRange.Columns(6).Cells
If cel = "Averages" Then
cel.Offset(, -3).Resize(, 3).FormulaR1C1 = "=average(r[2]c:r[" & cel.Offset(2, -3).End(xlDown).Row - cel.Row & "]c)"
End If
Next cel
End Sub

Open in new window

Author

Commented:
Tried this on a real data set and it works.
Can't say I understand it but thanks.
This was driving me nuts.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial