CODEWITHSUNDEEP
excelvba
user3536226
user3536226

Reputation: 41

Find highest number across row across all workbook

Find the top 5 highest number (value) on determined row (i.e. row 10) across all tabs in the workbook. Return the "name of the tab" and the value. 

Sub ShowMinMax()
    Dim vMax

        vMax = Application.WorksheetFunction.Max(Rows("10"))

    MsgBox "Maximum = " & vMax, vbInformation, "GetMax Values"
End Sub

Expected result should be: "Name of the tab" maxValue1 "Name of the tab" maxValue2 ... "Name of the tab" maxValue5

Upvotes: 0

Views: 64

Answers (1)

Scott Craner
Scott Craner

Reputation: 152505

This will iterate the sheets and return the top five numbers and their respective sheets.

Sub ShowMinMax()

    Dim MaxArr(1 To 5, 1 To 2) As Variant
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        Dim lstColumn As Long
        lstColumn = ws.Cells(10, ws.Columns.Count).End(xlToLeft).Column

        Dim rowArr As Variant
        rowArr = ws.Range(ws.Cells(10, 1), ws.Cells(10, lstColumn)).Value
        Dim i As Long
        For i = 1 To lstColumn
            If Not IsEmpty(rowArr) Then
            If IsNumeric(rowArr(1, i)) Then
                Dim j As Long
                For j = 1 To 5
                    If rowArr(1, i) > MaxArr(j, 2) Then
                        Dim k As Long
                        For k = 5 To j + 1 Step -1
                            MaxArr(k, 2) = MaxArr(k - 1, 2)
                            MaxArr(k, 1) = MaxArr(k - 1, 1)
                        Next k
                        MaxArr(j, 2) = rowArr(1, i)
                        MaxArr(j, 1) = ws.Name
                        Exit For
                    End If
                Next j
            End If
            End If
        Next i
    Next ws

    'Change line below to the correct output range        
    Worksheets("Sheet20").Range("A15").Resize(5, 2).Value = MaxArr


End Sub

This is what I got after running the above:

enter image description here

Upvotes: 1

Related Questions