find 10 max values in different sheets

[Guest]

Hi,

I have following code:

Sub MarkTheCells(SelRange As Range, worksheetname As String)
Dim l As Double, s As Double
Dim cell, SortRange As Range
Dim pos As Integer
Dim CellRow, CellCol As Long


pos = 0
SelRange.Interior.ColorIndex = xlNone
l = Application.Large(SelRange, 10)
s = Application.Small(SelRange, 10)
For Each cell In SelRange
If IsNumeric(cell) And _
Not IsEmpty(cell) And cell.Text <> "" Then
If cell.Value >= l Then
CellRow = cell.Row
CellCol = cell.Column
cell.Interior.ColorIndex = 3
Worksheets(worksheetname).Range("A1").Offset(20 + pos, 4).Value =
cell.Value
Worksheets(worksheetname).Range("A1").Offset(20 + pos, 3).Value =
Range("A1").Offset(CellRow - 1, 0).Value
Worksheets(worksheetname).Range("A1").Offset(20 + pos, 2).Value =
Range("A1").Offset(0, CellCol - 1).Value
pos = pos + 1
ElseIf cell.Value <= s Then
cell.Interior.ColorIndex = 5
End If
End If
Next



End Sub



This should select the 10 max and 10 min values in a selected range. It
should be possible to call it for different worksheets. But I get problems
with the Application.Large function. I can't find information on the
Application Methods.
Does anybody have an idea what to change in order to make this code work?
ANDY

 

[JulieD]

Hi Bandy

application.large
IMHO should read
Application.WorksheetFunction.Large
likewise for application.small

however, i don't think this is going to solve your problem

what are the worksheets and ranges that you want to look for the 10min / 10
max values in, will these change over time?

Cheers
JulieD

 

[Guest]

I could be way off base here but it just might work. On one sheet use the
large formula to determine the top 10 values for each sheet. Then take the
top ten values of that list you just created. This can be hard coded and
might be a little easier..

=large(Sheet1!A1:A100, 1)
=large(Sheet1!A1:A100, 2)
=large(Sheet1!A1:A100, 3)
....
=large(Sheet1!A1:A100, 10)

=large(Sheet2!A1:A100, 1)
=large(Sheet2!A1:A100, 2)
=large(Sheet2!A1:A100, 3)
....
=large(Sheet2!A1:A100, 10)

Then use the large function on these values you have just returned... If
your sheets are static it might be an easy way to do this without the code...
and you will get the top ten for each sheet to boot...

HTH

 

[Guest]

HI,

I really don't know what the problem was. I started completely new and now
it works. Large works either with application.large or with
application.worksheetfunctions.large. That does not matter.
What I changed was the activation of the sheet that I'm working on (I'm sure
there are ways to do it without activation but now it works).

Sub MarkTheCells(rng As Range, worksheetname As String)
Dim rng1 As Range
Dim l As Double, s As Double
Dim cell As Range
Dim pos As Integer


Worksheets(worksheetname).Activate
rng.Interior.ColorIndex = xlNone
l = Application.WorksheetFunction.Large(rng, 10)
s = Application.WorksheetFunction.Small(rng, 10)
For Each cell In rng
If IsNumeric(cell) And _
Not IsEmpty(cell) And cell.Text <> "" Then
If cell.Value >= l Then
cell.Interior.ColorIndex = 3
Range("A1").Offset(20 + pos, 4).Value = cell.Value
Range("A1").Offset(20 + pos, 3).Value =
Range("A1").Offset(cell.Row - 1, 0).Value
Range("A1").Offset(20 + pos, 2).Value = Range("A1").Offset(0,
cell.Column - 1).Value
pos = pos + 1
ElseIf cell.Value <= s Then
cell.Interior.ColorIndex = 5
End If
End If
Next

Range("C21").Resize(pos, 3).Sort Key1:=Range("E21"), Order1:=xlDescending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

End Sub