View Single Post
  #14   Report Post  
Posted to microsoft.public.excel.misc
Pivot Man[_2_] Pivot Man[_2_] is offline
external usenet poster
 
Posts: 15
Default Conditional Format for Object

Thanks again JLatham,

Unfortunately, I am getting an Runtime error '6' overflow error when I do
this. The code is stopping at the first uppercolor statement. Again, i
really appreciate your help.

"JLatham" wrote:

Sure, we can use a special type of If Then, the Select Case to deal with
these multiple conditions. You should be able to modify it for your needs
pretty easily:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim anyShape As Shape
Dim lowerLimit As Integer ' or other type
Dim upperLimit As Integer ' or other type
Dim lowerColor As Integer
Dim upperColor As Integer
Dim defaultColor As Integer

Application.EnableEvents = False
Select Case Target.Address
Case Is = "$A$1"
Set anyShape = Worksheets("Sheet1").Shapes("Oval 3")
lowerLimit = 10
upperLimit = 20
lowerColor = vbRed
upperColor = vbGreen
defaultColor = vbYellow
Case Is = "$B$1"
Set anyShape = Worksheets("Sheet1").Shapes("Rectangle 1")
lowerLimit = 10
upperLimit = 20
lowerColor = vbRed
upperColor = vbGreen
defaultColor = vbCyan
Case Is = "$C$1"
Set anyShape = Worksheets("Sheet1").Shapes("Rectangle 2")
lowerLimit = 10
upperLimit = 20
lowerColor = vbRed
upperColor = vbGreen
defaultColor = vbMagenta
Case Is = "$D$1"
Set anyShape = Worksheets("Sheet1").Shapes("Oval 2")
lowerLimit = 30
upperLimit = 40
lowerColor = vbRed
upperColor = vbGreen
defaultColor = vbMagenta
Case Is = "$E$1"
Set anyShape = Worksheets("Sheet1").Shapes("AutoShape 1")
lowerLimit = 130
upperLimit = 140
lowerColor = vbRed
upperColor = vbGreen
defaultColor = vbBlack
Case Else
'if not one of your addresses
Application.EnableEvents=True
Exit Sub ' get out!
End Select
anyShape.Fill.ForeColor.RGB = defaultColor
If Target.Value < lowerLimit Then
anyShape.Fill.ForeColor.RGB = lowerColor
ElseIf Target.Value upperColor Then
anyShape.Fill.ForeColor.RGB = upperColor
End If
Application.EnableEvents = True
Set anyShape=Nothing
End Sub


"Pivot Man" wrote:

Hello again,

the 5 shapes would be on the same page. Each refercing a different cell,
say a1 to a5.

I tried replicating the code and changing the shape name in VB but that did
not work.

any thoughts?

Thanks



"JLatham" wrote:

If each of these shapes is on a different worksheet (5 different sheets, 1
shape on each worksheet) then the exact same code will work for each
worksheet. Each sheet has it's own _Change() event! The only difference in
the code would be the name of the shape and any particulars about values and
the related color.

You can see this by choosing another worksheet and right-clicking on it's
tab and then choosing View Code. There will not be a Worksheet_Change()
event for that sheet. You can copy the original code, paste it in and make
changes unique to that particular sheet and shape. Excel will know which
sheet and shape on that sheet.

Is that clear? If not, let me know. Also, let me know if you are talking
about 5 different shapes on one sheet - in which case we'd have to really do
some changes to figure out which shape to work on based on the value entered
into A1.

"Pivot Man" wrote:

Of course...stumbled on another question as I was working on this. If I want
to change multiple shapes conditionally, based on different criteria, I
assumed I could copy the code and replace the "oval 5" with the name of the
shape identified in the space above cell A1. So the question is, how do i
apply the code that worked so well to multiple shapes. Ultimately, the
parameters for each of the shapes and the reference cell A1, will be
different but I have left them the same in the code below.

Thanks again to both you and Socratis.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim cir As Shape

'change to address of cell with value in it
If Target.Address < "$A$1" Then
Exit Sub ' no change in A1
End If
Application.EnableEvents = False
' Assuming your shape (Oval 5) is on worksheet (Sheet1).
Set cir = Worksheets("Sheet1").Shapes("Oval 3")
cir.Fill.ForeColor.RGB = vbYellow ' default

' use whatever values you need here
If Target.Value < 10 Then
cir.Fill.ForeColor.RGB = vbRed
ElseIf Target.Value 20 Then
cir.Fill.ForeColor.RGB = vbGreen
End If
Application.EnableEvents = True
End Sub


Private Sub W2orksheet_Change(ByVal Target As Range)
Dim cir As Shape

'change to address of cell with value in it
If Target.Address < "$A$1" Then
Exit Sub ' no change in A1
End If
Application.EnableEvents = False
' Assuming your shape (Oval 5) is on worksheet (Sheet1).
Set cir = Worksheets("Sheet1").Shapes("square 1")
cir.Fill.ForeColor.RGB = vbYellow ' default

' use whatever values you need here
If Target.Value < 10 Then
cir.Fill.ForeColor.RGB = vbRed
ElseIf Target.Value 20 Then
cir.Fill.ForeColor.RGB = vbGreen
End If
Application.EnableEvents = True
End Sub



"JLatham" wrote:

You're welcome. Glad I could help with the help that Socratis gave you to
begin with.

"Pivot Man" wrote:

This was so clear and easy...Thank you for dumbing it down. It worked like a
charm. I actually changed the .line to .fill and that gave me exactly the
effect I was looking for. Again, thanks for all of your help.



"JLatham" wrote:

Pivot Man,
I haven't tried his code, but looking at it, what it does is use the
currently selected cell as the one holding the value that controls the color
of the circle. So it would work like this: you click on the cell with the
control value in it and then use Tools | Macro | Macros to run this code.

To keep from having to choose the cell before running it, you could change
the Value = to specify the location of the value like (and I'd use something
other than the word value as the variable name, perhaps cirValue)
cirValue = Worksheets("Sheet1").Range("A1").Value
where Sheet1 is the name of the sheet and A1 is the cell with the value in it.

To be completely automated, you could move the code into the worksheet's
_Change event. That's easy enough to do: right-click on the worksheet's name
tab and choose [View Code] from the popup list. Then cut and paste this code
into the module, edit the sheet name and cell address as needed. Test it,
any time you make a change to the value in A1 (as coded) the circle should
react to the value change. Once you're sure it works properly, remove the
single apostrophe in front of the two 'Application.EnableEvents = statements
to make them active. That'll keep from continuously calling the routine if
lots of cells are changed at once, as with a massive delete, while it's
working on the circle's color.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cir As Shape

'change to address of cell with value in it
If Target.Address < "$A$1" Then
Exit Sub ' no change in A1
End If
'Application.EnableEvents = False
' Assuming your shape (Oval 5) is on worksheet (Sheet1).
Set cir = Worksheets("Sheet1").Shapes("Oval 5")
cir.Line.ForeColor.RGB = vbYellow ' default

' use whatever values you need here
If Target.value < 10 Then
cir.Line.ForeColor.RGB = vbRed
ElseIf Target.value 20 Then
cir.Line.ForeColor.RGB = vbGreen
End If
'Application.EnableEvents = True
End Sub





"Pivot Man" wrote:

Hi Socratis,

I am a newbee to the macro world. I tried to attach the macro to the shape
and it was not working. in the macros, do i need ot replace set cell =
Selection..change Selection to cell containing item of interest? Same
cell.value...overall, where do i refernce the cell which will drive the color
in this macro?

Thanks so much for your assistance.

"Socratis" wrote:

I concur with JLatham, but if you want to be able to format an object
conditionally, you might want to use the following macro.

Public Sub FormatCircle()
Dim cir As Shape

' Assuming your shape (Oval 5) is on worksheet (Sheet1).
Set cir = Worksheets("Sheet1").Shapes("Oval 5")
cir.Line.ForeColor.RGB = vbRed

Dim cell As Range
Set cell = Selection

Dim value As Long
value = cell.value

' use whatever range you like here
If value < 10 Then
cir.Line.ForeColor.RGB = vbRed
ElseIf value 20 Then
cir.Line.ForeColor.RGB = vbGreen
Else
cir.Line.ForeColor.RGB = vbYellow
End If
End Sub

similarly, you can use the following macro to format the desired range.

Public Sub FormatRangeConditionally()
Dim value As Long

value = Range("A1")

With Range("B2:B4")
If value < 10 Then
.Interior.Color = vbRed
ElseIf value 20 Then
.Interior.Color = vbGreen
Else
.Interior.Color = vbYellow
End If
End With
End Sub

Cheers,
socratis
"Pivot Man" wrote:

Looking to change the format of an object...change the color of a circle to
red if less than, yellow if between two values and green if greater than a
value. I can use condiitional formatting in a cell, just wondering if

A) you can apply condiitonal formatting to an object
or B) can you apply conditional formatting to cells outside of the result
cell. ie, depending on the results in cell A1, I want to change the color in
Cells B2 to B4.

Thanks