Excel maximum minimum value from a range across multiple sheets

Viewed 2177

I have the following formula drawing the maximum value from the data in column F over multiple sheets.

=MAX('Aug242018LB3STRDF$000'!F5:F39004,'Aug242018LB3STRDF$001'!F5:F39004,'Aug242018LB3STRDF$002'!F5:F39004,'Aug242018LB3STRDF$003'!F5:F39004,'Aug242018LB3STRDF$004'!F5:F39004,'Aug242018LB3STRDF$005'!F5:F39004,'Aug242018LB3STRDF$006'!F5:F39004,'Aug242018LB3STRDF$007'!F5:F39004,'Aug242018LB3STRDF$008'!F5:F39004,'Aug242018LB3STRDF$009'!F5:F39004,'Aug242018LB3STRDF$010'!F5:F39004,'Aug242018LB3STRDF$011'!F5:F39004,'Aug242018LB3STRDF$012'!F5:F39004,'Aug242018LB3STRDF$013'!F5:F39004,'Aug242018LB3STRDF$014'!F5:F39004,'Aug242018LB3STRDF$015'!F5:F39004,'Aug242018LB3STRDF$016'!F5:F39004,'Aug242018LB3STRDF$017'!F5:F39004,'Aug242018LB3STRDF$018'!F5:F39004,'Aug242018LB3STRDF$019'!F5:F39004,'Aug242018LB3STRDF$020'!F5:F39004,'Aug242018LB3STRDF$021'!F5:F39004,'Aug242018LB3STRDF$022'!F5:F39004,'Aug242018LB3STRDF$023'!F5:F39004,'Aug242018LB3STRDF$024'!F5:F39004,'Aug242018LB3STRDF$025'!F5:F39004,'Aug242018LB3STRDF$026'!F5:F39004,'Aug242018LB3STRDF$027'!F5:F39004,'Aug242018LB3STRDF$028'!F5:F39004,'Aug242018LB3STRDF$029'!F5:F39004)

It works really well, however it is not very adaptable. Often times I have a different # of sheets or the sheet name varies and so this forumla can only be used in one workbook. I was hoping there was a way in VBA to build a macro or application that would be able to detect the number of sheets, and possible be able to select my own range to compare (different columns)

2 Answers

You can create a 'first' worksheet at the beginning and hide it. Repeat the process with a 'last' worksheet at the end of the series. The formula becomes,

=max(first:last!f5:f39004)

Solved both issues of looping through all sheets and selecting the range/column. I created 2 functions (functions can be found below) one for the minimum and the other for the maximum. You only need to select the range as demonstrated in the picture below. Both function work even if you have blanks or text in the selected range across sheets, but if you have error they do not work.

To be able to use these functions. You need to copy past the functions source code (found below) in a module. The functions will be available only in the workbook you copied the functions to.

If you want the functions to be available to any workbook you open. You need to save the workbook that contains the function as an add in, then activate the add in. This is a really simple step Click Here to see how to do the add in thing

Note, if you type the functions say in "sheet1" Then you go to a different sheet say "sheet2" and change the numbers the functions will not automatically calculate. You need to go to the formula bar and press enter. If the number you change is in the same sheet as the sheet you typed the functions. It updates automatically

enter image description here

Minimum Across Sheets Function

Public Function Minimum_Across_Sheets(rngSelection As Range) As Double

Dim dMinimum_Value As Double
Dim bFirst_Value_Obtained As Boolean
Dim rng As Range
Dim wks As Worksheet

For Each wks In ActiveWorkbook.Worksheets

    For Each rng In rngSelection

        If IsNumeric(wks.Cells(rng.Row, rng.Column)) And Len(wks.Cells(rng.Row, rng.Column)) > 0 Then

            If Not bFirst_Value_Obtained Then
                dMinimum_Value = wks.Cells(rng.Row, rng.Column)
                bFirst_Value_Obtained = True
            End If

            If wks.Cells(rng.Row, rng.Column) < dMinimum_Value Then
                dMinimum_Value = wks.Cells(rng.Row, rng.Column)
            End If

        End If

    Next rng

Next wks

Minimum_Across_Sheets = dMinimum_Value
End Function

Maximum Across Sheets Function

Public Function Maximum_Across_Sheets(rngSelection As Range) As Double

Dim dMaximum_Value As Double
Dim bFirst_Value_Obtained As Boolean
Dim rng As Range
Dim wks As Worksheet

For Each wks In ActiveWorkbook.Worksheets

    For Each rng In rngSelection

        If IsNumeric(wks.Cells(rng.Row, rng.Column)) And Len(wks.Cells(rng.Row, rng.Column)) > 0 Then

            If Not bFirst_Value_Obtained Then
                dMaximum_Value = wks.Cells(rng.Row, rng.Column)
                bFirst_Value_Obtained = True
            End If

            If wks.Cells(rng.Row, rng.Column) > dMaximum_Value Then
                dMaximum_Value = wks.Cells(rng.Row, rng.Column)
            End If

        End If

    Next rng

Next wks

Maximum_Across_Sheets = dMaximum_Value
End Function

Hope this is useful to you.

Related