Is this possible with excel?

[Sam Harman]

Hi, I wondered if any of the excel experts could tell me how to do the
following if it is possible...


Column A is a Time formatted column and Column P is a number formatted
column as per the example below....



A P
13:20 4
13:20 6
13:20 6
13:20 8
13:20 9
13:20 10
13:20 11
13:50 2
13:50 3
13:50 4
13:50 5
13:50 6
13:50 8
14:20 1.25
14:20 1.75
14:20 3
14:20 3
14:20 3
14:20 5
14:20 6
14:20 7


What am I trying to do automatically either with a macro or by
programming is as follows:

Highlight by formatting the bg colour of the cell green the top four
values in column P for each time slot.....so in the example above in
the 13:20 the numbers 4, 6, 6, 8, 9 would all be highlighted as these
are the top four values....

In the 13:50 example 2,3,4 and 5 would be highlighted and in the 14:20
all numbers woulkd be highlighted.......

I somehow need the macro etc to look at the time and when it changes
from one time to the next it goes to column P and highlights the top
four values.......as you will see as some values are duplicated it is
not always gour numbers that get highlighted......


Is this possible?

Thanks in advance

Sam

 

[joeu2004]

Column A is a Time formatted column and Column P is a
number formatted column as per the example below.... [....]
Highlight by formatting the bg colour of the cell green
the top four values in column P for each time slot

Perhaps the macro below does what you want.

But....

so in the example above in the 13:20 the numbers
4, 6, 6, 8, 9 would all be highlighted as these
are the top four values....

In the 13:50 example 2,3,4 and 5 would be highlighted
and in the 14:20 all numbers woulkd be highlighted.

By what criteria are 4,6,6,8,9 the "top" four values among 4,6,6,8,9,10,11
for time 13:20? And 2,3,4,5 are the "top" four values among 2,3,4,5,6,8 for
time 13:50? And all the "top" __four__ values among 1.25,1.75,3,3,3,5,6,7
for time 14:20?

If you mean __bottom__ (lowest) four values and you are totally wrong about
14:20, change

If values(j, 1) > values(k, 1) Then k = j

to

If values(j, 1) < values(k, 1) Then k = j

in Private Sub sortSubset. Of course, it would be nice to also change
"largest" to "smallest" in the comments.


-----

Option Explicit

Sub highlightTopN()

' ***** customize *****
Const bgColor = 35 ' pale green
Const topN As Long = 4
Const firstTime As String = "A1"
Const valCol As String = "P"

Dim times, values
Dim n As Long, i As Long, j As Long, k As Long, h As Long
Dim firstVal As Range, x

' copy data
times = Range(firstTime, Range(firstTime).End(xlDown))
n = UBound(times, 1)
Set firstVal = Cells(Range(firstTime).Row, valCol)
values = firstVal.Resize(n)
ReDim origOffset(1 To n) As Long
For i = 1 To n: origOffset(i) = i - 1: Next

i = 1
Do
' find end of time slot
For j = i To n - 1
If times(j + 1, 1) <> times(i, 1) Then Exit For
Next
firstVal.Offset(i - 1).Resize(j - i + 1).Interior.ColorIndex = xlNone
sortSubset i, j, values, origOffset
' highlight at most top N
k = 1: h = i
Do
' treat equal values as one among top N
x = firstVal.Offset(origOffset(h))
Do
With firstVal.Offset(origOffset(h)).Interior
.ColorIndex = bgColor
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
h = h + 1
If h > j Then Exit Do
Loop While firstVal.Offset(origOffset(h)) = x
If k = topN Then Exit Do
k = k + 1
Loop Until h > j
i = j + 1
Loop Until i > n
End Sub

Private Sub sortSubset(ByVal n As Long, ByVal m As Long, _
ByRef values, ByRef origOffset() As Long)
Dim i As Long, j As Long, k As Long, t As Double, x As Long
' descending sort
For i = n To m - 1
' find largest
k = i
For j = i + 1 To m
If values(j, 1) > values(k, 1) Then k = j
Next
If k <> i Then
' move largest
t = values(i, 1): values(i, 1) = values(k, 1): values(k, 1) = t
x = origOffset(i): origOffset(i) = origOffset(k): origOffset(k) = x
End If
Next
End Sub


----- original message -----

 

[Don Guillett]

Hi, I wondered if any of the excel experts could tell me how to do the
following if it is possible...

Column A is a Time formatted column and Column P is a number formatted
column as per the example below....

A               P
13:20           4
13:20           6
13:20           6
13:20           8
13:20           9
13:20           10
13:20           11
13:50           2
13:50           3
13:50           4
13:50           5
13:50           6
13:50           8
14:20           1.25
14:20           1.75
14:20           3
14:20           3
14:20           3
14:20           5
14:20           6
14:20           7

What am I trying to do automatically either with a macro or by
programming is as follows:

Highlight by formatting the bg colour of the cell green the top four
values in column P for each time slot.....so in the example above in
the 13:20 the numbers 4, 6, 6, 8, 9 would all be highlighted as these
are the top four values....

In the 13:50 example 2,3,4 and 5 would be highlighted and in the 14:20
all numbers woulkd be highlighted.......

I somehow need the macro etc to look at the time and when it changes
from one time to the next it goes to column P and highlights the top
four values.......as you will see as some values are duplicated it is
not always gour numbers that get highlighted......

Is this possible?

Thanks in advance

Sam

======
This macro does it for times in col A and numbers in col B. Modify to
suit
I can send a file.

Option Explicit
Sub ColorTopFourforEachTime_SAS()
Application.ScreenUpdating = False
Columns("b").Interior.ColorIndex = xlNone
Dim lr As Long
Dim i As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row
'Get Unique times to col D
Columns("d").ClearContents
Range("A3:A" & lr).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("D1"), CriteriaRange:="", Unique:=True
'Filter and color cells
For i = 2 To Cells(Rows.Count, "d").End(xlUp).Row
Range("e2") = Format(Cells(i, "d"), "hh:mm")
Range("A3:B" & lr).AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range("E1:F2"), Unique:=False
'color cells
Range("b3:b" & lr).SpecialCells(xlCellTypeVisible) _
.Interior.ColorIndex = i + 4
Next i

ActiveSheet.ShowAllData
Application.ScreenUpdating = True
End Sub

 

[joeu2004]

Const bgColor = 35 ' pale green [....]
With firstVal.Offset(origOffset(h)).Interior
.ColorIndex = bgColor

ColorIndex is a position in a palette. You cannot count on that being pale
green, an index I captured using Record Macro. Perhaps a better
implementation would be:

Dim bgColor as long
bgColor = RGB(204,255,204) ' pale green
[....]
With firstVal.Offset(origOffset(h)).Interior
.Color = bgColor

 

[Sam Harman]

Column A is a Time formatted column and Column P is a
number formatted column as per the example below.... [....]
Highlight by formatting the bg colour of the cell green
the top four values in column P for each time slot

Perhaps the macro below does what you want.

But....

so in the example above in the 13:20 the numbers
4, 6, 6, 8, 9 would all be highlighted as these
are the top four values....

In the 13:50 example 2,3,4 and 5 would be highlighted
and in the 14:20 all numbers woulkd be highlighted.

By what criteria are 4,6,6,8,9 the "top" four values among 4,6,6,8,9,10,11
for time 13:20? And 2,3,4,5 are the "top" four values among 2,3,4,5,6,8 for
time 13:50? And all the "top" __four__ values among 1.25,1.75,3,3,3,5,6,7
for time 14:20?

If you mean __bottom__ (lowest) four values and you are totally wrong about
14:20, change

If values(j, 1) > values(k, 1) Then k = j

to

If values(j, 1) < values(k, 1) Then k = j

in Private Sub sortSubset. Of course, it would be nice to also change
"largest" to "smallest" in the comments.


-----

Option Explicit

Sub highlightTopN()

' ***** customize *****
Const bgColor = 35 ' pale green
Const topN As Long = 4
Const firstTime As String = "A1"
Const valCol As String = "P"

Dim times, values
Dim n As Long, i As Long, j As Long, k As Long, h As Long
Dim firstVal As Range, x

' copy data
times = Range(firstTime, Range(firstTime).End(xlDown))
n = UBound(times, 1)
Set firstVal = Cells(Range(firstTime).Row, valCol)
values = firstVal.Resize(n)
ReDim origOffset(1 To n) As Long
For i = 1 To n: origOffset(i) = i - 1: Next

i = 1
Do
' find end of time slot
For j = i To n - 1
If times(j + 1, 1) <> times(i, 1) Then Exit For
Next
firstVal.Offset(i - 1).Resize(j - i + 1).Interior.ColorIndex = xlNone
sortSubset i, j, values, origOffset
' highlight at most top N
k = 1: h = i
Do
' treat equal values as one among top N
x = firstVal.Offset(origOffset(h))
Do
With firstVal.Offset(origOffset(h)).Interior
.ColorIndex = bgColor
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
h = h + 1
If h > j Then Exit Do
Loop While firstVal.Offset(origOffset(h)) = x
If k = topN Then Exit Do
k = k + 1
Loop Until h > j
i = j + 1
Loop Until i > n
End Sub

Private Sub sortSubset(ByVal n As Long, ByVal m As Long, _
ByRef values, ByRef origOffset() As Long)
Dim i As Long, j As Long, k As Long, t As Double, x As Long
' descending sort
For i = n To m - 1
' find largest
k = i
For j = i + 1 To m
If values(j, 1) > values(k, 1) Then k = j
Next
If k <> i Then
' move largest
t = values(i, 1): values(i, 1) = values(k, 1): values(k, 1) = t
x = origOffset(i): origOffset(i) = origOffset(k): origOffset(k) = x
End If
Next
End Sub


----- original message -----

Hi, I wondered if any of the excel experts could tell me how to do the
following if it is possible...


Column A is a Time formatted column and Column P is a number formatted
column as per the example below....



A P
13:20 4
13:20 6
13:20 6
13:20 8
13:20 9
13:20 10
13:20 11
13:50 2
13:50 3
13:50 4
13:50 5
13:50 6
13:50 8
14:20 1.25
14:20 1.75
14:20 3
14:20 3
14:20 3
14:20 5
14:20 6
14:20 7


What am I trying to do automatically either with a macro or by
programming is as follows:

Highlight by formatting the bg colour of the cell green the top four
values in column P for each time slot.....so in the example above in
the 13:20 the numbers 4, 6, 6, 8, 9 would all be highlighted as these
are the top four values....

In the 13:50 example 2,3,4 and 5 would be highlighted and in the 14:20
all numbers woulkd be highlighted.......

I somehow need the macro etc to look at the time and when it changes
from one time to the next it goes to column P and highlights the top
four values.......as you will see as some values are duplicated it is
not always gour numbers that get highlighted......


Is this possible?

Thanks in advance

Sam

Sorry, sorry, sorry, I made a mistake in the 14:20 the number to be
highlighted there would be the first and smallest four unique values.
Therefore 1.25 is the first and smallest value, 1.75 is the second
smallest value, all three 3's would be highlighted as the thirs
smallest value and then 5 would be highlighted as the fourth and last
value

Sam

 

[Sam Harman]

Const bgColor = 35 ' pale green [....]
With firstVal.Offset(origOffset(h)).Interior
.ColorIndex = bgColor

ColorIndex is a position in a palette. You cannot count on that being pale
green, an index I captured using Record Macro. Perhaps a better
implementation would be:

Dim bgColor as long
bgColor = RGB(204,255,204) ' pale green
[....]
With firstVal.Offset(origOffset(h)).Interior
.Color = bgColor

Hi, that seems to have worked a treat - thankl you so much and thanks
to everyone who replied.

Can I ask if I can adapt that to be the reverse of the original
function.

For example to take the first four highest values, but also to ignore
a zero value as follows:


Column A Column U

13:50 78 - Highest value 1 highlighted
13:50 77 - Highest value 2 highlighted
13:50 76 - Highest value 3 highlighted
13:50 0 - not highlighted
13:50 0 - not highlighted
13:50 0 - not highlighted
13:50 0 - not highlighted
14:20 78 - Highest value 1 highlighted
14:20 77 - Highest value 2 highlighted
14:20 77 - Highest value 2 highlighted
14:20 77 - Highest value 2 highlighted
14:20 76 - Highest value 3 highlighted
14:20 75 - Highest value 4 highlighted
14:20 74 - not highlighted
14:50 0 - not highlighted
14:50 0 - not highlighted
14:50 0 - not highlighted
14:50 0 - not highlighted
14:50 0 - not highlighted
15:20 123 - highest value 1 highlighted
15:20 121 - highest value 2 highlighted
15:20 121 - highest value 2 highlighted
15:20 120 - highest value 3 highlighted
15:20 119 - highest value 4 highlighted

Thanks again

Sam

 

[Don Guillett]

Const bgColor = 35  ' pale green [....]
        With firstVal.Offset(origOffset(h)).Interior
           .ColorIndex = bgColor

ColorIndex is a position in a palette.  You cannot count on that beingpale
green, an index I captured using Record Macro.  Perhaps a better
implementation would be:

Dim bgColor as long
bgColor = RGB(204,255,204)    ' pale green
[....]
With firstVal.Offset(origOffset(h)).Interior
   .Color = bgColor

Hi, that seems to have worked a treat - thankl you so much and thanks
to everyone who replied.

Can I ask if I can adapt that to be the reverse of the original
function.

For example to take the first four highest values, but also to ignore
a zero value as follows:

Column A     Column U

13:50           78 - Highest value 1 highlighted
13:50           77 - Highest value 2 highlighted
13:50           76 - Highest value 3 highlighted
13:50           0 - not  highlighted
13:50           0 - not highlighted
13:50           0 - not highlighted
13:50           0 - not highlighted
14:20           78 - Highest value 1 highlighted
14:20           77 - Highest value 2 highlighted
14:20           77 - Highest value 2 highlighted
14:20           77 - Highest value 2 highlighted
14:20           76 - Highest value 3 highlighted
14:20           75 - Highest value 4 highlighted
14:20           74 - not highlighted
14:50           0 - not highlighted
14:50           0 - not highlighted
14:50           0 - not highlighted
14:50           0 - not highlighted
14:50           0 - not highlighted
15:20           123 - highest value 1 highlighted              
15:20           121 - highest value 2 highlighted
15:20           121 - highest value 2 highlighted
15:20           120 - highest value 3 highlighted
15:20           119 - highest value 4 highlighted

Thanks again

Sam

=============
This will color as desired Quickly using advanced filter. I can send
you a file OR
dguillett1@ gmail.com

Follow this setup EXACTLY
A3=A P3=P
Q1=A R1=A T1=4 (for top 4)
S2= =AND(P4<>0,P4>=$T$2)
T2= =LARGE(IF(A4:A24=R2,P424,0),T1)
T2 must be an Array formula
Times a4 and below
Numbers p4 and below
Then run this macro
Option Explicit
Sub ColorTopFourforEachTime_SAS()
Application.ScreenUpdating = False
Columns("p").Interior.ColorIndex = xlNone
Dim lr As Long
Dim i As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row
'Get Unique times to col D
Columns("q").ClearContents
Range("A3:A" & lr).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("q1"), CriteriaRange:="", Unique:=True
'Filter and color cells
For i = 2 To Cells(Rows.Count, "q").End(xlUp).Row
Range("r2") = Format(Cells(i, "q"), "hh:mm")
Range("A3" & lr).AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range("r1:s2"), Unique:=False
'color cells
Range("p3" & lr).SpecialCells(xlCellTypeVisible) _
.Interior.ColorIndex = 35
Next i

ActiveSheet.ShowAllData
Application.ScreenUpdating = True
End Sub

 

[joeu2004]

Can I ask if I can adapt that to be the reverse of the original
function. For example to take the first four highest values,
but also to ignore a zero value as follows:

Column A Column U
13:50 78 - Highest value 1 highlighted
13:50 77 - Highest value 2 highlighted
13:50 76 - Highest value 3 highlighted
13:50 0 - not highlighted
13:50 0 - not highlighted
13:50 0 - not highlighted
13:50 0 - not highlighted

If you truly mean to find the largest (not smallest) 4 values this time, the
following macro should do the trick.

Note: It can be improved if all values are greater than or equal to zero
and if you do not expect any empty cells or cells with null strings.


-----

Option Explicit

Sub highlightTopN()

' ***** customize *****
Const topN As Long = 4
Const firstTime As String = "A1"
Const valCol As String = "U"

Dim times, values
Dim n As Long, i As Long, j As Long, k As Long, h As Long
Dim firstVal As Range, x, bgColor as Long

bgColor = RGB(204, 255, 204) ' pale green

' copy data
times = Range(firstTime, Range(firstTime).End(xlDown))
n = UBound(times, 1)
Set firstVal = Cells(Range(firstTime).Row, valCol)
values = firstVal.Resize(n)
ReDim origOffset(1 To n) As Long
For i = 1 To n: origOffset(i) = i - 1: Next

i = 1
Do
' find end of time slot
For j = i To n - 1
If times(j + 1, 1) <> times(i, 1) Then Exit For
Next
firstVal.Offset(i - 1).Resize(j - i + 1).Interior.ColorIndex = xlNone
sortSubset i, j, values, origOffset
' highlight at most top N
k = 1: h = i
Do
' treat equal values as one among top N
x = firstVal.Offset(origOffset(h))
If x <> "" And x <> 0 Then
Do
With firstVal.Offset(origOffset(h)).Interior
.Color = bgColor
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
h = h + 1
If h > j Then Exit Do
Loop While firstVal.Offset(origOffset(h)) = x
If k = topN Then Exit Do
k = k + 1
End If
Loop Until h > j
i = j + 1
Loop Until i > n
End Sub

Private Sub sortSubset(ByVal n As Long, ByVal m As Long, _
ByRef values, ByRef origOffset() As Long)
Dim i As Long, j As Long, k As Long, t As Double, x As Long
' descending sort
For i = n To m - 1
' find largest
k = i
For j = i + 1 To m
If values(j, 1) > values(k, 1) Then k = j
Next
If k <> i Then
' move largest
t = values(i, 1): values(i, 1) = values(k, 1): values(k, 1) = t
x = origOffset(i): origOffset(i) = origOffset(k): origOffset(k) = x
End If
Next
End Sub

 

[joeu2004]

Errata.... Sorry, I was rushed. My previous macro has a fatal defect. The
macro below has been tested.

Can I ask if I can adapt that to be the reverse of the original
function. For example to take the first four highest values,
but also to ignore a zero value as follows:

Column A Column U
13:50 78 - Highest value 1 highlighted
13:50 77 - Highest value 2 highlighted
13:50 76 - Highest value 3 highlighted
13:50 0 - not highlighted
13:50 0 - not highlighted
13:50 0 - not highlighted
13:50 0 - not highlighted

If you truly mean to find the largest (not smallest) 4 values this time, the
following macro should do the trick.

Note: It can be improved if all values are greater than or equal to zero
and if you do not expect any empty cells or cells with null strings.

-----

Option Explicit

Sub highlightTopN()

' ***** customize *****
Const topN As Long = 4
Const firstTime As String = "A1"
Const valCol As String = "U"

Dim times, values
Dim n As Long, i As Long, j As Long, k As Long, h As Long
Dim firstVal As Range, x, bgColor As Long

bgColor = RGB(204, 255, 204) ' pale green

' copy data
times = Range(firstTime, Range(firstTime).End(xlDown))
n = UBound(times, 1)

Set firstVal = Cells(Range(firstTime).Row, valCol)
With firstVal.Resize(n)
.Interior.ColorIndex = xlNone
values = .Value
End With

ReDim origOffset(1 To n) As Long
For i = 1 To n: origOffset(i) = i - 1: Next

i = 1
Do
' find end of time slot
For j = i To n - 1
If times(j + 1, 1) <> times(i, 1) Then Exit For
Next
sortSubset i, j, values, origOffset
' highlight at most top N
k = 1: h = i
Do
' treat equal values as one among top N
x = firstVal.Offset(origOffset(h))
If x = "" Or x = 0 Then
h = h + 1
Else
Do
With firstVal.Offset(origOffset(h)).Interior
.Color = bgColor
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
h = h + 1
If h > j Then Exit Do
Loop While firstVal.Offset(origOffset(h)) = x
If k = topN Then Exit Do
k = k + 1
End If
Loop Until h > j
i = j + 1
Loop Until i > n
End Sub

Private Sub sortSubset(ByVal n As Long, ByVal m As Long, _
ByRef values, ByRef origOffset() As Long)
Dim i As Long, j As Long, k As Long, t As Double, x As Long
' descending sort
For i = n To m - 1
' find largest
k = i
For j = i + 1 To m
If values(j, 1) > values(k, 1) Then k = j
Next
If k <> i Then
' move largest
t = values(i, 1): values(i, 1) = values(k, 1): values(k, 1) = t
x = origOffset(i): origOffset(i) = origOffset(k): origOffset(k) = x
End If
Next
End Sub

 

[Don Guillett]

I wrote:
Const bgColor = 35  ' pale green
[....]
        With firstVal.Offset(origOffset(h)).Interior
           .ColorIndex = bgColor
ColorIndex is a position in a palette.  You cannot count on that being pale
green, an index I captured using Record Macro.  Perhaps a better
implementation would be:
Dim bgColor as long
bgColor = RGB(204,255,204)    ' pale green
[....]
With firstVal.Offset(origOffset(h)).Interior
   .Color = bgColor

Hi, that seems to have worked a treat - thankl you so much and thanks
to everyone who replied.

Can I ask if I can adapt that to be the reverse of the original
function.

For example to take the first four highest values, but also to ignore
a zero value as follows:

Column A     Column U

13:50           78 - Highest value 1 highlighted
13:50           77 - Highest value 2 highlighted
13:50           76 - Highest value 3 highlighted
13:50           0 - not  highlighted
13:50           0 - not highlighted
13:50           0 - not highlighted
13:50           0 - not highlighted
14:20           78 - Highest value 1 highlighted
14:20           77 - Highest value 2 highlighted
14:20           77 - Highest value 2 highlighted
14:20           77 - Highest value 2 highlighted
14:20           76 - Highest value 3 highlighted
14:20           75 - Highest value 4 highlighted
14:20           74 - not highlighted
14:50           0 - not highlighted
14:50           0 - not highlighted
14:50           0 - not highlighted
14:50           0 - not highlighted
14:50           0 - not highlighted
15:20           123 - highest value 1 highlighted             
15:20           121 - highest value 2 highlighted
15:20           121 - highest value 2 highlighted
15:20           120 - highest value 3 highlighted
15:20           119 - highest value 4 highlighted

Thanks again

Sam

=============
This will color as desired Quickly using advanced filter. I can send
you a file OR
dguillett1@ gmail.com

Follow this setup EXACTLY
A3=A    P3=P
Q1=A    R1=A            T1=4 (for top 4)

'NO use next line instead'> S2=     =AND(P4<>0,P4>=$T$2)
S2=AND(P4<>0,P4<=$T$2)
'==
'no use next line instead> T2=     =LARGE(IF(A4:A24=R2,P424,0),T1)