how to find highest and lowest value based on a specific range in Excel VBA?

Question

I got this code from several references to find the highest and lowest scores:

Then there is something that makes me curious, How do I implement this code in a certain range where I have thousands of data?

Example: The code is run when I want to find the 10 or 30 highest data values in the range B2: B4000 contained in Sheet1, and put the results in sheet 1, range C2?

Function Max(ParamArray values() As Variant) As Variant
   Dim maxValue, Value As Variant
   maxValue = values(0)
   For Each Value In values
       If Value > maxValue Then maxValue = Value
   Next
   Max = maxValue
     End Function

Function Min(ParamArray values() As Variant) As Variant
   Dim minValue, Value As Variant
   minValue = values(0)
   For Each Value In values
       If Value < minValue Then minValue = Value
   Next
   Min = minValue
End Function

Answer 1

Try the next code, please:

Sub LargestInRange_array()
  Dim sh As Worksheet, arr, nrR As Long, i As Long
  
  Set sh = ActiveSheet             'use here the sheet you need
  arr = sh.Range("B2:B4000").Value 'put the range in an array
  
  nrR = 5 'the number of Top to be returned (that 10 to 30, in your question)

  'clear the previous returned Top:
  sh.Range("C2:C" & sh.Range("C" & sh.rows.count).End(xlUp).row).ClearContents
  For i = 1 To nrR
    sh.Range("C" & i + 1).Value = WorksheetFunction.Large(arr, i)
  Next i
End Sub

It places as many largest values you set in the variable nrR , starting from "C2".

Edited :

Please, try the version using a function and needing only a range and the Top number. It determines which is the last row in the column to be processed:

Sub testTopXSales()
 Dim sh As Worksheet, rng As Range, arrTop, lastR
  
  Set sh = ActiveSheet                   'use here the sheet you need
  lastR = sh.Range("B" & sh.rows.count).End(xlUp).row 'last row in the range to be processed
                                                                          'adapt "B" to the column you use
  Set rng = sh.Range("B2:B" & lastR)      'use here the range to be processed
  rng.Offset(0, 1).EntireColumn.ClearContents 'clear the clumn to the right contents
  arrTop = TopXSales(rng, 10)              'defining the Top array, using the function
  
  'drop the array content in the next column:
  rng.Offset(0, 1).Resize(UBound(arrTop) + 1, 1).Value = Application.Transpose(arrTop)
End Sub

Function TopXSales(rng As Range, TopNr As Long) As Variant
   Dim arr, arrTop, i As Long, k As Long
   ReDim arrTop(TopNr - 1) 'redim the array to keep the largest value (- 1 because it is a 1D array starting from 0)
   arr = rng.Value              'put the range in an array. It will work with the range itself, but it should be faster so
   For i = 0 To TopNr - 1    'creating the Top array
        arrTop(k) = WorksheetFunction.Large(arr, i + 1): k = k + 1
   Next i
   TopXSales = arrTop       'make the function to return the Top array
End Function

Answer 2

Hy maybe it will help you out

Private Sub hy()
    
    Dim foo As Object
    Set foo = test(3)
    
    Dim i As Integer
    For i = 0 To foo.count - 1
        Debug.Print foo(i)
    Next i
    
End Sub


Function test(count As Integer) As Object

    Dim arr As Object
    Set arr = CreateObject("System.Collections.ArrayList")
    
    arr.Add 70
    arr.Add 30
    arr.Add 60
    arr.Add 50
    arr.Add 200
    arr.Add 10
    arr.Sort
    
    Set test = CreateObject("System.Collections.ArrayList")
    
    Dim i As Integer
    For i = arr.count - 1 To arr.count - count Step -1
        test.Add arr(i)
    Next i
    
    
End Function