Going to cell with maximum value

  • Thread starter Thread starter Brian Allen
  • Start date Start date
B

Brian Allen

I need a function or macro to select cells with the ten highest values
in selected rows over 25 worksheets. I am not looking the maximum of
each sheet. It is possible all ten could be in one sheet. I have a
feeling the code would need to loop through all 2024 numbers, placing
them in an array and sorting from maximum to minimum - grab the ten
with the highest value then activate the cells with the maximums so
that they can all changed to a set value.

Any suggestions
 
Brian,

Here's some code that seems to work based on my understanding of the
task. If not, it might give you some ideas. I don't think you can
select or activate cells on multiple sheets simultaneously. Like you
said, I think you have to use an array and sort like you indicated.


Sub Test()
Dim Cell As Range
Dim ULimit As Long
Dim Indx As Long
Dim TempArray As Variant
Dim NumTop As Long
Dim Ans As Double

NumTop = 10 'example: Change the top 10

'Ask the user what value to change to.
'You can't use Union method because you're working
'with multiple sheets. I don't no of a way to activate or
'select ranges on separate sheets.
Ans = Application.InputBox("Enter value for top " & NumTop & ".",
"Change Values", Type:=1)

'Count of all cells in the named ranges.
'You could revise the code and not used named
'ranges, but named ranges make it easier.
ULimit = Range("RangeSheet1").Count + Range("RangeSheet2").Count +
Range("RangeSheet3").Count

If ULimit = 0 Then Exit Sub

'Need an array to store:
'(1) - Cell value
'(2) - Worksheet name
'(3) - Cell address
ReDim TempArray(1 To ULimit, 1 To 4) As Variant

'Start filling the array for each named range.

Indx = 1
For Each Cell In Range("RangeSheet1")
If IsNumeric(Cell) Then
TempArray(Indx, 1) = Cell
TempArray(Indx, 2) = Cell.Parent.Name
TempArray(Indx, 3) = Cell.Address
Indx = Indx + 1
End If
Next Cell
'These next 2 loops are identical to the one above
'Could probably use a function instead to be more
'robust/efficient, but this demonstrates the concept.
For Each Cell In Range("RangeSheet2")
If IsNumeric(Cell) Then
TempArray(Indx, 1) = Cell
TempArray(Indx, 2) = Cell.Parent.Name
TempArray(Indx, 3) = Cell.Address
Indx = Indx + 1
End If
Next Cell
For Each Cell In Range("RangeSheet3")
If IsNumeric(Cell) Then
TempArray(Indx, 1) = Cell
TempArray(Indx, 2) = Cell.Parent.Name
TempArray(Indx, 3) = Cell.Address
Indx = Indx + 1
End If
Next Cell

If NumTop > UBound(TempArray) Then NumTop = UBound(TempArray)

'Search the user group for array sorting procedures and
'get ALL procedures created by Stephen Bullen for sorting.
'Sort array in descending order.
Call procSort(TempArray, "D", 1)

'Loop thru sorted array and change the number of applicable
'cells.
Indx = 1
For Indx = 1 To NumTop
Worksheets(TempArray(Indx, 2)).Range(TempArray(Indx, 3)) = Ans
Next Indx
End Sub

HTH,
Steve Hieb
 
Back
Top