Attn Ron Rosenfeld

S

Sam Harman

Hi Ron, I hope you are well and as always thanks for the help you have
provided to me.

However it has been a couple of weeks now since I asked for your help
and I think it it time for another request LOL :)

This is a small request and hopefully just a minor tweak to one of the
macros you have previously provided......

It is the macro that highlights the top four values which then
highlights the top value with a background colour of yellow and the
remaining values with a background colour of green as per below:

----------------------------------------------------------------------------------------------------

Sub Color2ORNew()
Dim rTimes As Range, rValues As Range, c As Range
Dim APOffset As Long
Dim tTimes() As Variant, dPVals() As Double
Dim collTime As Collection, collColU As Collection
Dim bLowest As Boolean
Dim i As Long, j As Long

On Error Resume Next

Set rTimes = Application.InputBox(Prompt:="Select the Times", _
Default:=Selection.Address, Type:=8)
If rTimes Is Nothing Then Exit Sub

Set rValues = Application.InputBox("Select a cell in the column of
Values", Type:=8)
If rValues Is Nothing Then Exit Sub

On Error GoTo 0

bLowest = IIf(MsgBox("Lowest 4?", vbYesNo) = vbYes, True, False)

APOffset = rValues.Column - rTimes.Column

'Unique list of times
Set collTime = New Collection
On Error Resume Next
For Each c In rTimes
collTime.Add Item:=c.Value, Key:=CStr(c.Value)
Next c
On Error GoTo 0

ReDim tTimes(0 To collTime.Count - 1, 0 To 2)
For i = 0 To collTime.Count - 1
tTimes(i, 0) = collTime(i + 1)
Next i

'unique list of rValues values for each time
For i = 0 To UBound(tTimes, 1)
Set collColU = New Collection
On Error Resume Next
For Each c In rTimes
If c.Value = tTimes(i, 0) Then
With c.Offset(columnoffset:=APOffset)
If bLowest = True Then collColU.Add
Item:=CDbl(.Text), Key:=CStr(.Text)
If bLowest = False And .Value <> 0 Then
collColU.Add Item:=CDbl(.Text), Key:=CStr(.Text)
End With
End If
Next c
On Error GoTo 0
If collColU.Count > 0 Then
ReDim dPVals(0 To collColU.Count - 1)
For j = 0 To UBound(dPVals)
dPVals(j) = collColU(j + 1)
Next j
End If
With WorksheetFunction
If bLowest Then
tTimes(i, 1) = .Small(dPVals, .Min(UBound(dPVals) + 1,
2))
tTimes(i, 2) = .Min(dPVals)
Else
tTimes(i, 1) = .Large(dPVals, .Min(UBound(dPVals) + 1,
2))
tTimes(i, 2) = .Max(dPVals)
End If

End With
Next i

'color the cells
For i = 0 To UBound(tTimes, 1)
For Each c In rTimes
If c.Value = tTimes(i, 0) Then
With c.Offset(columnoffset:=APOffset)
If bLowest = False Then
Select Case CDbl(.Text)
Case Is = tTimes(i, 2)
.Interior.Color = vbYellow
Case Is >= tTimes(i, 1)
.Interior.Color = vbGreen
Case Else
.Interior.Color = xlNone
End Select
ElseIf bLowest = True Then
Select Case CDbl(.Text)
Case Is = tTimes(i, 2)
.Interior.Color = vbYellow
Case Is <= tTimes(i, 1)
.Interior.Color = vbGreen
Case Else
.Interior.Color = xlNone
End Select
End If
End With
End If
Next c
Next i
End Sub

----------------------------------------------------------------------------------------------------

The question I have is this....is it possible once the highlighted
values have been selected and the cell background colour applied to
make the text red?

Thanks in advance

Cheers

Sam
 
R

Ron Rosenfeld

Select Case CDbl(.Text)
Case Is = tTimes(i, 2)
.Interior.Color = vbYellow
Case Is >= tTimes(i, 1)
.Interior.Color = vbGreen
Case Else
.Interior.Color = xlNone
End Select
ElseIf bLowest = True Then
Select Case CDbl(.Text)
Case Is = tTimes(i, 2)
.Interior.Color = vbYellow
Case Is <= tTimes(i, 1)
.Interior.Color = vbGreen
Case Else
.Interior.Color = xlNone
End Select

It's just a matter of adding a line to set the font color after the line that sets the fill (interior) color (and also resets it back to black if there is not going to be shading):

Select Case CDbl(.Text)
Case Is = tTimes(i, 2)
.Interior.Color = vbYellow
.Font.Color = vbRed
Case Is >= tTimes(i, 1)
.Interior.Color = vbGreen
.Font.Color = vbRed
Case Else
.Interior.Color = xlNone
.Font.Color = vbBlack
End Select
ElseIf bLowest = True Then
Select Case CDbl(.Text)
Case Is = tTimes(i, 2)
.Interior.Color = vbYellow
.Font.Color = vbRed
Case Is <= tTimes(i, 1)
.Interior.Color = vbGreen
.Font.Color = vbRed
Case Else
.Interior.Color = xlNone
.Font.Color = vbBlack
End Select
 
S

Sam Harman

It's just a matter of adding a line to set the font color after the line that sets the fill (interior) color (and also resets it back to black if there is not going to be shading):

Select Case CDbl(.Text)
Case Is = tTimes(i, 2)
.Interior.Color = vbYellow
.Font.Color = vbRed
Case Is >= tTimes(i, 1)
.Interior.Color = vbGreen
.Font.Color = vbRed
Case Else
.Interior.Color = xlNone
.Font.Color = vbBlack
End Select
ElseIf bLowest = True Then
Select Case CDbl(.Text)
Case Is = tTimes(i, 2)
.Interior.Color = vbYellow
.Font.Color = vbRed
Case Is <= tTimes(i, 1)
.Interior.Color = vbGreen
.Font.Color = vbRed
Case Else
.Interior.Color = xlNone
.Font.Color = vbBlack
End Select

Thank you very much once again

Cheers

Sam
 
S

Sam Harman

Hi Ron, I seem to have lost my initial post so am reposting here in
case you didnt see it...

Hi Ron, hope you are well

I have another query which I hope you can help with....

It is relation to the Master Table setup below but this time with a
twist lol

In the master table i have recorded where each competition was and the
result as follows:

Date Time Location Dog Position

01 Mar 2011 10.00 Location A Dog A 1
01 Mar 2010 10.00 Location A Dog A 4
01 Mar 2009 10.00 Location A Dog A FTC

The results of the competition only ever go from 1 - 40 but there are
also alpha results such as failed to complete would be FTC

What I would like to do if possible have a column in the main
worksheet that shows how the dog performed the last times it was at
that same competition.

So in the example above, the cell in the main spreadsheet would be
populated as follows: FTC-4-1 with a hyphen between each result...

Also as before I would add in the >dates forumula so that for the next
comp it would show performance only up to that date and not update
previous entries based on new data

Finally, when I need to update the range in the master table as I add
new data is it possible to automate that process or do I need to
individually update the name ranges to extend to new data when added?

Hope that all makes sense and thanks again for all your help.....it is
really appreciated

Kind regards


Sam
 
R

Ron Rosenfeld

Hi Ron, I seem to have lost my initial post so am reposting here in
case you didnt see it...

Hi Ron, hope you are well

I have another query which I hope you can help with....

It is relation to the Master Table setup below but this time with a
twist lol

In the master table i have recorded where each competition was and the
result as follows:

Date Time Location Dog Position

01 Mar 2011 10.00 Location A Dog A 1
01 Mar 2010 10.00 Location A Dog A 4
01 Mar 2009 10.00 Location A Dog A FTC

The results of the competition only ever go from 1 - 40 but there are
also alpha results such as failed to complete would be FTC

What I would like to do if possible have a column in the main
worksheet that shows how the dog performed the last times it was at
that same competition.

So in the example above, the cell in the main spreadsheet would be
populated as follows: FTC-4-1 with a hyphen between each result...

Also as before I would add in the >dates forumula so that for the next
comp it would show performance only up to that date and not update
previous entries based on new data

Finally, when I need to update the range in the master table as I add
new data is it possible to automate that process or do I need to
individually update the name ranges to extend to new data when added?

Hope that all makes sense and thanks again for all your help.....it is
really appreciated

Kind regards

Did you see my response to your email of 10/8/2011?

Date: Sat, 08 Oct 2011 12:51:15 -0400
Message-ID: <[email protected]>
 
S

Sam Harman

Hi Ron, I did see your response of 8/10 and thanked you for it...it
worked great

This is a slightly different query as below which I hope you can help
with. This one is about showing results in a different format.

I hope I have explained it alright below...

Thansk in advance

Sam
 
R

Ron Rosenfeld

Hi Ron, I did see your response of 8/10 and thanked you for it...it
worked great

This is a slightly different query as below which I hope you can help
with. This one is about showing results in a different format.

I hope I have explained it alright below...

Thansk in advance

Sam

It'll have to wait, Sam. I'll be out of town for a while.
 
R

Ron Rosenfeld

Hi Ron, I seem to have lost my initial post so am reposting here in
case you didnt see it...

Hi Ron, hope you are well

I have another query which I hope you can help with....

It is relation to the Master Table setup below but this time with a
twist lol

In the master table i have recorded where each competition was and the
result as follows:

Date Time Location Dog Position

01 Mar 2011 10.00 Location A Dog A 1
01 Mar 2010 10.00 Location A Dog A 4
01 Mar 2009 10.00 Location A Dog A FTC

The results of the competition only ever go from 1 - 40 but there are
also alpha results such as failed to complete would be FTC

What I would like to do if possible have a column in the main
worksheet that shows how the dog performed the last times it was at
that same competition.

So in the example above, the cell in the main spreadsheet would be
populated as follows: FTC-4-1 with a hyphen between each result...

Also as before I would add in the >dates forumula so that for the next
comp it would show performance only up to that date and not update
previous entries based on new data

Finally, when I need to update the range in the master table as I add
new data is it possible to automate that process or do I need to
individually update the name ranges to extend to new data when added?

Hope that all makes sense and thanks again for all your help.....it is
really appreciated

Kind regards


Sam

Hi Sam,

I'll answer the easiest question first -- so far as updating the ranges that the defined names refer to automatically, that should not be a problem. Did you see one of my Oct 8 posts where I provided you with dynamic names for those ranges?

So far as the rest, I'm sure it can be done. Please post a copy of your current workbook on a public site (e.g. something like SkyDrive in a shared folder) and post a link here. In your workbook include all the relevant calculations and data, and what you have now; as well as a clear explanation and examples of what it is that you want. Although your explanation above seems clear, but I do not have the time to reconstruct everything that we've accomplished up to this point.

-- Rpm
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top