How to get the maximum, minimum and average of a range?

marlonsaveri · Mar 8, 2011

I use this code to discover, but it's not running:

Code:

For lin = foundcell.Row To foundcell.MergeArea(foundcell.MergeArea.count).Row
        For col = 4 To numcol - 1
            Cells(lin, col).Interior.Color = RGB(212, 200, 200)
            If Not myrange Is Nothing Then
                Set myrange = Union(myrange, Cells(lin, col))
            End If
        Next col
    Next lin

 LabelMax.Caption = WorksheetFunction.max(myrange)
 LabelMin.Caption = WorksheetFunction.min(myrange)
 LabelAverage.Caption = WorksheetFunction.Average(myrange)

col: column
lin: line / row
numcol: number of columns

So, how could I find max, min and avarage value?
If I save cells(i,j) in a matrix(i,j), could I use something like LabelMax.Caption = worksheetFunction.max(matrix)? And, to use worksheetFunction, need I declare some library?

Thanks.

tweedle · Mar 8, 2011

So is there a "Set myrange = " somewhere before this code?
if not, then it is nothing and will not get into the Union statement.
Did you intend to test the value of Cells(lin, col) maybe?

So, how could I find max, min and avarage value?

You're doing fine once myRange gets fixed.

If I save cells(i,j) in a matrix(i,j), could I use something like LabelMax.Caption = worksheetFunction.max(matrix)?

fix myRange and you should be fine how you have it.

And, to use worksheetFunction, need I declare some library?

Nope, it's readily available with the Excel.Application.

marlonsaveri · Mar 9, 2011

Tweedle, u'r right. myrange begins with nothing. It's ok now.

There's a last trouble:
when I finished the search and myrange is nothing yet, ie, when there was no number wrote in the range, occurs a problem with .average (I think it's just with average).
I tried:

Code:

If  WorksheetFunction.Average(interval) Then
LabelMed.Caption = "Méd: " & WorksheetFunction.Average(interval)
End If

but that's not enough, the problem continues:
Err 1004, it's not possible get the property "Average" in worksheetfunction.

tweedle · Mar 9, 2011

What is 'interval' ?
Needs to be an array of values i.e. myRange, which it would still be a good idea to test for is not nothing....

marlonsaveri · Mar 9, 2011

Sorry, I had changed the name, "interval" is the same as "myrange".
Using "On Error GoTo...", there's no error msg - although don't solve.

It's a little odd; when myrange is blank, an error occurs. So I use "On Error GoTo".
Other cases:
1. When myrange is just one merged cell, max = min = average = value, ok.
2. When myrange is more then a row, max = maxvalue; min = minvalue, but average is nothing.

tweedle · Mar 9, 2011

Can you post your current code please?
somewhere I'm expecting

Code:

Dim interval as range 
< snip >
set interval = myRange

to make interval a range of cells being passed into the worksheet functions, yes?

marlonsaveri · Mar 9, 2011

The form has 1 combobox, 2 buttons and 3 labels.

Code:

    Option Explicit
    Dim numlin As Long
    Dim numcol As Long

Code:

Private Sub UserForm_Initialize()
    
    On Error GoTo Errorsee
    
    Dim maxlin As Integer [COLOR=SeaGreen]'number of rows; property[/COLOR]
    Dim maxcol As Integer [COLOR=SeaGreen]'number of columns; data related that property[/COLOR]
    Dim base As String [COLOR=SeaGreen]'keep the word "basis", because that's the first word in the table; and, this row has filled cells to every column[/COLOR]
    Dim i As Integer

[COLOR=SeaGreen]'   CALCULATE HOW MANY ROWS AND COLUMNS THE TABLE HAS[/COLOR]
    Dim foundcell As Range
    Dim wordsearched As String
    
[COLOR=SeaGreen]     'rows:[/COLOR]
    numlin = Range("A" & Rows.count).End(xlUp).Row
    numlin = Range("A" & numlin).MergeArea.count + numlin
    
   [COLOR=SeaGreen] 'find the word "basis", go to the end of table and takes the number of col[/COLOR]
    wordsearched = "Basis"
    Set foundcell = Cells.Find(what:=wordsearched, After:=Range("A1"), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    If Not foundcell Is Nothing Then
        numcol = Cells(foundcell.Row, Columns.count).End(xlToLeft).Column
    End If

[COLOR=SeaGreen]'   Put items in combobox[/COLOR]
    For i = 10 To numlin [COLOR=SeaGreen]'10 first rows are titles[/COLOR],[COLOR=SeaGreen] others have names of properties. However, there're some merged cell, so we need remove blanks.[/COLOR]
            ComboBox1.AddItem Cells(i, 2).FormulaR1C1
    Next
    
[COLOR=SeaGreen]'   Should Remove blanks[/COLOR]
    For i = 1 To ComboBox1.ListCount - 1
        If Len(ComboBox1.List(i)) = 0 Then
           ComboBox1.RemoveItem i
        End If
    Next
    
    Exit Sub
    
Errorsee:
    
End Sub

Code:

Private Sub CommandButton1_Click() 'button close
   userform1.Hide [COLOR=SeaGreen]'closes form[/COLOR]
[COLOR=SeaGreen]'   Remove colors[/COLOR]
    With Cells.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

Private Sub CommandButton2_Click()

    On Error GoTo Errorsee
    
[COLOR=SeaGreen]'   DECLARE[/COLOR]
    Dim busca As Range
    Dim col As Integer
    Dim lin As Integer
    Dim wordseached As String
    Dim interval As Range

[COLOR=SeaGreen]'   Remove colors[/COLOR]
    With Cells.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
[COLOR=SeaGreen]'   Hide labels[/COLOR]
    LabelMax.Caption = ""
    LabelMin.Caption = ""
    LabelMed.Caption = ""
    LabelMax.Visible = False
    LabelMin.Visible = False
    LabelMed.Visible = False

[COLOR=SeaGreen]'   Find the combobox1.text in the sheet.[/COLOR]
    wordsearched = ComboBox1.value
    Set busca = Cells.Find(what:=wordsearched, After:=Range("B3"), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
   
    
[COLOR=SeaGreen]'   Paint cells[/COLOR]
    Range(busca.Address).Interior.Color = RGB(212, 200, 200)
    For lin = busca.Row To busca.MergeArea(busca.MergeArea.count).Row  [COLOR=SeaGreen]'from first to last merged cell[/COLOR]
       For col = 3 To numcol [COLOR=SeaGreen]'3 first columns has titles.[/COLOR]
         Cells(lin, col).Interior.Color = RGB(212, 200, 200)
         Next
    Next

    
[COLOR=SeaGreen]'   Get max, min and average inside range[/COLOR]
    For lin = busca.Row To busca.MergeArea(busca.MergeArea.count).Row
        For col = 4 To numcol
            If Not interval Is Nothing Then
                Set interval = Union(interval, Cells(lin, col))
             Else
                Set interval = Cells(lin, col)
            End If
        Next col
    Next lin

    LabelMax.Visible = True
    LabelMin.Visible = True
    LabelMed.Visible = True
    
    LabelMax.Caption = "Máx: " & WorksheetFunction.max(interval)
    LabelMin.Caption = "Mín: " & WorksheetFunction.min(interval)
    LabelMed.Caption = "Méd: " & WorksheetFunction.Average(interval)
    Exit Sub
    
Errorsee:

End Sub

tweedle · Mar 9, 2011

So you're running calcs against a pivot table, is that right?
Based on that assumption, I believe how you cycle through the rows can vary on your pivot design.

the closest I got, not knowing the design of your pivot, looks like this:

Code:

[COLOR=#2e8b57]  'Get max, min and average inside range[/COLOR]
    lastrow = busca.MergeArea.End(xlDown).Row - 1
    For lin = busca.Row To lastrow

marlonsaveri · Mar 10, 2011

I don't know why, but I couldn't send the file by here. This is the code:
Actually, in a first sheet, I have a form that finds the sheet by name (in this sample, NY012010), so, this sheet is opened and this second forms is showed:

Code:

  Option Explicit
    Dim numrows As Long
    Dim numcol As Long
Private Sub CommandButton1_Click() 'botão fechar
    specific_prop.Hide
'   Remove colors
    With Cells.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub
Private Sub CommandButton2_Click()
    On Error GoTo Trataerro
    
'   Declare
    Dim foundcell As Range
    Dim col As Integer
    Dim lin As Integer
    Dim wordsearched As String
    Dim interval As Range
'   Remove colors
    With Cells.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
'   Hide labels
    LabelMax.Caption = ""
    LabelMin.Caption = ""
    LabelMed.Caption = ""
    LabelMax.Visible = False
    LabelMin.Visible = False
    LabelMed.Visible = False
'   Find combobox.text in the sheet
    wordsearched = ComboBox1.value
    Set foundcell = Cells.Find(what:=wordsearched, After:=Range("B3"), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
   
    
'   Paint cells
    Range(foundcell.Address).Interior.Color = RGB(212, 200, 200)
    For lin = foundcell.Row To foundcell.MergeArea(foundcell.MergeArea.count).Row
       For col = 3 To numcol 'unless 2 first columns
         Cells(lin, col).Interior.Color = RGB(212, 200, 200)
         Next
    Next
    
'   Get max, min and average
    For lin = foundcell.Row To foundcell.MergeArea(foundcell.MergeArea.count).Row
        For col = 4 To numcol
            If Not interval Is Nothing Then
                Set interval = Union(interval, Cells(lin, col))
             Else
                Set interval = Cells(lin, col)
            End If
        Next col
    Next lin
    LabelMax.Visible = True
    LabelMin.Visible = True
    LabelMed.Visible = True
    
    LabelMax.Caption = "Máx: " & WorksheetFunction.max(interval)
    LabelMin.Caption = "Mín: " & WorksheetFunction.min(interval)
    LabelMed.Caption = "Average: " & WorksheetFunction.Average(interval)
    Exit Sub
    
Trataerro:
End Sub

Private Sub UserForm_Initialize()
    
    On Error GoTo ErrorSee
    
    Dim maxlin As Integer
    Dim maxcol As Integer
    Dim price As String
    Dim i As Integer
'   Calc how many rows and columns the table has
    Dim foundcell As Range
    Dim wordsearched As String
    
    'linhas:
    numrows = Range("A" & Rows.count).End(xlUp).Row
    numrows = Range("A" & numrows).MergeArea.count + numrows
    
    'find the word "price", go to the end of the table to know the number of columns
    wordsearched = "price"
    Set foundcell = Cells.Find(what:=wordsearched, After:=Range("A1"), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    If Not foundcell Is Nothing Then
        numcol = Cells(foundcell.Row, Columns.count).End(xlToLeft).Column
    End If
'   Put items to the combobox
    For i = 10 To numrows 'descontamos as primeiras linhas, com os títulos
            ComboBox1.AddItem Cells(i, 2).FormulaR1C1
    Next
    
'   Remove empty items
    For i = 1 To ComboBox1.ListCount - 1
        If Len(ComboBox1.List(i)) = 0 Then
           ComboBox1.RemoveItem i
        End If
    Next
    
    Exit Sub
    
ErrorSee:
    
End Sub

marlonsaveri · Mar 20, 2011

Hi again,
I tried in another forum, and there I put the link:
http://www.vbforums.com/showpost.php?p=3981016&postcount=12

Thanks.

I found a book about VBA Office2003 whose writter is "MrExcel", good.

How to get the maximum, minimum and average of a range?

marlonsaveri

Board Regular

Excel Facts

tweedle

Well-known Member

marlonsaveri

Board Regular

tweedle

Well-known Member

marlonsaveri

Board Regular

tweedle

Well-known Member

marlonsaveri

Board Regular

tweedle

Well-known Member

marlonsaveri

Board Regular

marlonsaveri

Board Regular

Similar threads

Forum statistics

Share this page

How to get the maximum, minimum and average of a range?

Board Regular

Excel Facts

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Board Regular

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock