I need help with the following please:

1. In sheetA Range("A2:B200") there is a price list (integers). I need
a macro that will loop through the range and list the 4 integers which
appear most in the range. The macro should list these 4 most occuring
integers in Range("C2:C4")

2. Also, I need a second macro that will list the 4 least occurring
integers in the same range("A2:B200"). This list should be placed in
Range("D2:D4)

I will greatly appreciate any assistance. Thanks.
~Flex~

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

What to do with ties,

1 occurs 10 times
2 occurs 9 times
3 occurs 8 times
4 occurs 8 times
5 occurs 8 times
6 occurs 8 times

What is the range of your integers. 0 to 100 as an example.

the list is in both column A and B?

--
Regards,
Tom Ogilvy

"flex zax" wrote in message
...
I need help with the following please:

1. In sheetA Range("A2:B200") there is a price list (integers). I need
a macro that will loop through the range and list the 4 integers which
appear most in the range. The macro should list these 4 most occuring
integers in Range("C2:C4")

2. Also, I need a second macro that will list the 4 least occurring
integers in the same range("A2:B200"). This list should be placed in
Range("D2:D4)

I will greatly appreciate any assistance. Thanks.
~Flex~

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Hi Tom -
* If there are ties, list all of the ties as well in range("C") even
though the usual 4 (if no ties) would be in range("C2:C4).

* The range of the integers are from 0 to 100. Some integers appear
multiple times and others not at all.

*What I meant by Range("A:B") was that any cell in any of these column
can contain any value. But all integers are in columns A and B.

Thanks in advance.
~Flex~


*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

This adds a "scratch" sheet and does all the work on this sheet. Then it
writes the results where you specified.

I have commented out the code to delete the added sheet. You can look at it
to make sure the macro is getting the correct values. Once you are
satisfied the macro works, you can uncomment the sh1.Delete code and the
macro will delete the scratch sheet. On the scratch sheet, the integers are
listed in column C and the frequencies in D

In C2 is the 4th highest occuring value down to the highest value
In D2 is the lowest value down to the 4th lowest.

Sub GetExtremes()
Dim sh As Worksheet, sh1 As Worksheet
Dim rng1 As Range, Large4 As Long, Small4 As Long
Dim rngSmall As Range, rngLarge As Range
Dim resSmall As Variant, resLarge As Variant
Set sh = ActiveSheet
Set sh1 = Worksheets.Add
sh1.Range("A2:A200").Value = sh.Range("A2:A200").Value
sh1.Range("A201:A399").Value = sh.Range("B2:B200").Value
sh1.Range("A2:A400").Sort Key1:=sh1.Range("A2"), _
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
sh1.Range("A1").Value = "Header1"
sh1.Range("C1").Value = "Header1"
sh1.Range("A1:A399").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("C1"), _
Unique:=True
Set rng1 = sh1.Range(sh1.Range("C2"), _
sh1.Range("C2").End(xlDown))
rng1.Offset(0, 1).Formula = "=Countif(A:A,C2)"
rng1.Offset(0, 1).Formula = rng1.Offset(0, 1).Value
rng1.Resize(, 2).Sort Key1:=rng1.Offset(0, 1), _
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Large4 = Application.Large(rng1.Offset(0, 1), 4)
Small4 = Application.Small(rng1.Offset(0, 1), 4)
resLarge = Application.Match(Large4, rng1.Offset(0, 1), 0)
Set rngLarge = sh1.Range(rng1(resLarge), rng1(rng1.Count))
sh.Range("C2").Resize(rngLarge.Count, 1).Value = _
rngLarge.Value
resSmall = Application.Match(Small4, rng1.Offset(0, 1), 1)
Set rngSmall = sh1.Range(rng1(1), rng1(resSmall))
sh.Range("D2").Resize(rngSmall.Count, 1).Value = _
rngSmall.Value
sh.Activate
Application.DisplayAlerts = False
'sh1.Delete
Application.DisplayAlerts = True
End Sub


--
Regards,
Tom Ogilvy

flex zax wrote in message
...


Hi Tom -
* If there are ties, list all of the ties as well in range("C") even
though the usual 4 (if no ties) would be in range("C2:C4).

* The range of the integers are from 0 to 100. Some integers appear
multiple times and others not at all.

*What I meant by Range("A:B") was that any cell in any of these column
can contain any value. But all integers are in columns A and B.

Thanks in advance.
~Flex~


*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Thanks Tom & Rob. You are super!!

~Flex~


*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Flex,

WorksheetFunction.Large and WorksheetFunction.Small are your keywords here.

Sub test()
Const cCount = 4
Dim rng As Range, i As Long, j As Long, lngTemp As Long, lngLast As Long

With Sheet1
Set rng = .Range("A:B")

'Largest
i = 1: j = 0
Do Until j = cCount
lngTemp = WorksheetFunction.Large(rng, i)
.Cells(i + 1, 3).Value = lngTemp
i = i + 1
If j = 0 Or lngLast < lngTemp Then
lngLast = lngTemp
j = j + 1
End If
Loop

'Smallest
i = 1: j = 0
Do Until j = cCount
lngTemp = WorksheetFunction.Small(rng, i)
.Cells(i + 1, 4).Value = lngTemp
i = i + 1
If j = 0 Or lngLast < lngTemp Then
lngLast = lngTemp
j = j + 1
End If
Loop
End With
End Sub


--
Rob van Gelder - http://www.vangelder.co.nz/excel


"flex zax" wrote in message
...


Hi Tom -
* If there are ties, list all of the ties as well in range("C") even
though the usual 4 (if no ties) would be in range("C2:C4).

* The range of the integers are from 0 to 100. Some integers appear
multiple times and others not at all.

*What I meant by Range("A:B") was that any cell in any of these column
can contain any value. But all integers are in columns A and B.

Thanks in advance.
~Flex~


*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!