Vba: calculate average under certain conditions

[Nelson78]

Hello everybody.

I have column J - populated only by numbers except for the header - for which I need the average value.

Dim lastrow_g As Long
lastrow_g = Cells(Rows.Count, "J").End(xlUp).Row

Dim range_average As Range
Set range_average = Range("J2:J" & lastrow_g)

Dim aver as Variant
aver = Application.WorksheetFunction.average(range_average)

No problem up to this point.

Now, the operation becomes harder.

1) I have to calculate the average of the values in column J that in column B (and same row) have the value "ALPHA" or "BETA";
2) Then, with reference to the point 1, I need to calculate the average of the 50 higher values.

Any suggestions?

Thank's.

 

[MickG]

Try this:-
NB:-the code assumes you have at least 50 numbers that match the criteria.

[COLOR="Navy"]Sub[/COLOR] MG09Jul40
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, nRng [COLOR="Navy"]As[/COLOR] Range, nSum [COLOR="Navy"]As[/COLOR] Double, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("J2", Range("J" & Rows.count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Dn.Offset(, -8).Value = "ALPHA" Or Dn.Offset(, -8).Value = "BETA" [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
nRng.Interior.Color = vbYellow
[COLOR="Navy"]For[/COLOR] n = 1 To 50
    nSum = nSum + Application.Large(nRng, n)
[COLOR="Navy"]Next[/COLOR] n
MsgBox nSum / 50 '[COLOR="Green"][B] Average of 50 Highest numbers.[/B][/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Kaper]

Using similar approach to original post, so relying on built in worksheetfunctions, but not working on ranges, but rather on arrays, one could do it as :

Dim lastrow_g As Long, i As Long, table_average As Variant
Dim table_condition As Variant, max_k As Double, aver As Double


lastrow_g = Cells(Rows.Count, "J").End(xlUp).Row
table_average = Range("J2:J" & lastrow_g).Value
table_condition = Range("B2:B" & lastrow_g).Value
For i = 1 To lastrow_g - 1 'not lastrow_g, because data starts from row 2 in a sheet
  If table_condition(i, 1) <> "ALPHA" And table_condition(i, 1) <> "BETA" Then
    table_average(i, 1) = ""
  End If
Next i
If Application.WorksheetFunction.Count(table_average) < 50 Then
  MsgBox "Not enough data"
Else
  max_k = Application.WorksheetFunction.Large(table_average, 50)
  For i = 1 To lastrow_g - 1
    If table_average(i, 1) < max_k Then
      table_average(i, 1) = ""
    End If
  Next i
  aver = Application.WorksheetFunction.Average(table_average)
End If

 

[Nelson78]

Try this:-
NB:-the code assumes you have at least 50 numbers that match the criteria.

[COLOR="Navy"]Sub[/COLOR] MG09Jul40
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, nRng [COLOR="Navy"]As[/COLOR] Range, nSum [COLOR="Navy"]As[/COLOR] Double, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("J2", Range("J" & Rows.count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Dn.Offset(, -8).Value = "ALPHA" Or Dn.Offset(, -8).Value = "BETA" [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
nRng.Interior.Color = vbYellow
[COLOR="Navy"]For[/COLOR] n = 1 To 50
    nSum = nSum + Application.Large(nRng, n)
[COLOR="Navy"]Next[/COLOR] n
MsgBox nSum / 50 '[COLOR="Green"][B] Average of 50 Highest numbers.[/B][/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

Well, excellent suggestion.
Thank's.

 

[MickG]

You're welcome