View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Nick H[_3_] Nick H[_3_] is offline
external usenet poster
 
Posts: 48
Default Multiple maximums in column

Hi Steve,

Try this (beware of wrap-arou
nd)...

Assumptions:
- The three columns are consecutive
- The set of groups is selected and ordered

You could of course use a defined range name rather than 'Selection'.
Or, if you know the column and/or column header you could define the
group range at run-time.

Public Sub FlagMaximums()
Dim c As Range
Dim rngGroups As Range
Dim arrFlags()
Dim TopRow As Long
Dim CurrentGroup
Dim MaxPct As Single
Dim RecentMax As Long
Dim i As Long

Set rngGroups = Selection
TopRow = 0
MaxPct = 0
RecentMax = -1

ReDim arrFlags(rngGroups.Rows.Count - 1)

For Each c In rngGroups
If TopRow = 0 Then TopRow = c.Row

If Len(c.Value) 0 Then
arrFlags(c.Row - TopRow) = 0

If c.Value = CurrentGroup Then
If c.Offset(0, 1) MaxPct Then
arrFlags(RecentMax) = 0
RecentMax = c.Row - TopRow
arrFlags(RecentMax) = 1
MaxPct = c.Offset(0, 1)
End If
Else
RecentMax = c.Row - TopRow
arrFlags(RecentMax) = 1
MaxPct = c.Offset(0, 1)
CurrentGroup = c.Value
End If
End If
Next c

rngGroups.Offset(0, 2) = Application.WorksheetFunction.Transpose
(arrFlags)
End Sub