Calculating the Median, Mean, and GeoMean of dynamic range

[cameron.beyers]

I have a spreadsheet with Data in Columns A-H. Column B is an ID value that will repeat an unknown amount of times. For each Value in Column B I need to calculate the Median, Mean, and GeoMean for the corresponding range of "G_:H_"

Ex.

Column B	Column G	Column H
2	10	5
2	13	9
2	9	2
3	8	2
3	7	3

<tbody>
</tbody>

For Column B = 2
I need to Calculate for the range "G2:H4"









I need the Median, Mean, and Geo Mean values to paste in Columns N-P for each different Station Index. My code only calculates for the first Station ID

Here is the code for what I have so far

Sub Median()

    Dim r As Long
    Dim stndx As String
    Dim i As Long
    Dim x As Integer
    
    
    Application.Calculation = xlCalculationManual
    
    r = Cells(Rows.Count, "A").End(xlUp).Row
    x = 2
    stndx = Cells(r, 2).Value[ATTACH]47030[/ATTACH]
     
     For i = r To 8 Step -1
      If Cells(i, 2).Value <> stndx Then
        Cells(x + 1, 11).Value = Cells(i, 1).Value
        Cells(x + 1, 12).Value = Cells(i, 2).Value
        Cells(x + 1, 13).Value = Cells(i, 4).Value
        Cells(x + 1, 14).Value = Application.Median(Range("G2:H" & i))
        Cells(x + 1, 15).Value = Application.Average(Range("G2:H" & i))
        
        End If
    Next i
        
Application.Calculation = xlCalculationAutomatic

End Sub

Thanks in advance!!

 

[sdruley]

Column B	Column G	Column H
2	10	5
2	13	9
2	9	2
3	8	2
3	7	3

<colgroup><col width="64" span="3" style="width:48pt"> </colgroup><tbody>
</tbody>

Cameron, from the upper left "2" to the lower right "3" define a range name called "bank".
Insert the following code into a module and it should give you a report.

Sub Cameron()Dim MedianStation1
Dim GeoMeanStation1
Dim MeanStation1
Dim MedianStation2
Dim GeoMeanStation2
Dim MeanStation2
Dim MedianStation3
Dim GeoMeanStation3
Dim MeanStation3
Dim DBank As Variant
Dim DataArray1(100)
Dim DataArray2(100)
Dim DataArray3(100)
Dim I1, I2, I3 As Integer
Dim WF As WorksheetFunction
Dim cell As Range
Set WF = WorksheetFunction
DBank = Application.Range("bank")
u = UBound(DBank)
For i = 1 To u
Select Case DBank(i, 1)
Case 1
    Array1Counter = Array1Counter + 2
    DataArray1(Array1Counter - 1) = DBank(i, 2)
    DataArray1(Array1Counter) = DBank(i, 3)
Case 2
    Array2Counter = Array2Counter + 2
    DataArray2(Array2Counter - 1) = DBank(i, 2)
    DataArray2(Array2Counter) = DBank(i, 3)
Case 3
    Array3Counter = Array3Counter + 2
    DataArray3(Array2Counter - 1) = DBank(i, 2)
    DataArray3(Array2Counter) = DBank(i, 3)
Case Else


End Select
Next i


On Error Resume Next
MedianStation1 = WF.Median(DataArray1())
GeoMeanStation1 = WF.GeoMean(DataArray1())
MeanStation1 = WF.Average(DataArray1())
MedianStation2 = WF.Median(DataArray2())
MeanStation2 = WF.Average(DataArray2())
GeoMeanStation2 = WF.GeoMean(DataArray2())
MedianStation3 = WF.Median(DataArray3())
MeanStation3 = WF.Average(DataArray3())
GeoMeanStation3 = WF.GeoMean(DataArray3())


MsgBox "Station1  " & Chr(13) _
& "Median = " & MedianStation1 & Chr(13) _
& "Mean = " & MeanStation1 & Chr(13) _
& "GeoMean = " & GeoMeanStation1 & Chr(13) & Chr(13) _
& "Station2  " & Chr(13) _
& "Median = " & MedianStation2 & Chr(13) _
& "Mean = " & MeanStation2 & Chr(13) _
& "GeoMean = " & GeoMeanStation2 & Chr(13) & Chr(13) _
& "Station3  " & Chr(13) _
& "Median = " & MedianStation3 & Chr(13) _
& "Mean = " & MeanStation3 & Chr(13) _
& "GeoMean = " & GeoMeanStation3 & Chr(13)
End Sub