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

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