Formatting via VBA

G

Guest

Hi gang
I am trying to use this code to achieve grreater than 3 condition CF.

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("A1:a100")) Is Nothing Then
With Target
Select Case LCase(.Value)
Case "Case1": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex = 3
Case "Case2": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex = 5
Case "Case3": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex = 10
Case "Case4": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex = 19
Case "Case5": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex = 20
Case "Case6": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex = 34
End Select
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub


2 Questions...

1 How can I add and AND to the case? IE., Case1 is "Dog" and >0. (I want to color only cells that are greater than 0.)

2 The formatting is on a report that is not updated except by links to another Sheet. Neither change event or calculate event as I see it will really work in this instance without having to go back and over type the values in A1:A100. Can I adapt the code so I can assign it to a button and run it from there, without having to go overtype all of the values A1:A100?

Thanks!
Steve
 
T

Tom Ogilvy

Not sure how a cell can both be equal to "Dog" and >0, so I assume you want
to check some other cell in proximity to column A on the row being checked.
Also, as written the code looks for the specific strings "Case1", "Case2",
etc. I assume your recognize this.

Private Sub Commandbutton1_Click()
On Error GoTo ws_exit:
Application.EnableEvents = False
For each cell in Me.Range("A1:A100")
With cell
if cell.Offset(0,1).Value > 0 then
Select Case LCase(.Value)
Case "Case1": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex
= 3
Case "Case2": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex
= 5
Case "Case3": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex
= 10
Case "Case4": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex
= 19
Case "Case5": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex
= 20
Case "Case6": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex
= 34
End Select
End if
End With
Next

ws_exit:
Application.EnableEvents = True
End Sub


--
Regards,
Tom Ogilvy


Steve said:
Hi gang
I am trying to use this code to achieve grreater than 3 condition CF.

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("A1:a100")) Is Nothing Then
With Target
Select Case LCase(.Value)
Case "Case1": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex = 3
Case "Case2": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex = 5
Case "Case3": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex = 10
Case "Case4": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex = 19
Case "Case5": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex = 20
Case "Case6": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex = 34
End Select
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub


2 Questions...

1 How can I add and AND to the case? IE., Case1 is "Dog" and >0. (I want
to color only cells that are greater than 0.)
2 The formatting is on a report that is not updated except by links to
another Sheet. Neither change event or calculate event as I see it will
really work in this instance without having to go back and over type the
values in A1:A100. Can I adapt the code so I can assign it to a button and
run it from there, without having to go overtype all of the values A1:A100?
 
G

Guest

Thanks for the reply Tom
looks like this may work. you did well in translating my greater than 0 part. The cells to the right of Col 1 >0 are the ones I wanted formatted and color based on the Case in ColA. I have created the button from the controls menu and when I R-Click the button and View code, the code shows up, but I cannot click the button. What am I doing wrong?
Thanks
Steve
 
T

Tom Ogilvy

You need to take it out of design mode (the upper left button on the
control toolbox with the drawing triangle symbol should appear depressed.
Click it so it does not appear depressed and you are out of design mode).

--
Regards,
Tom Ogilvy

Steve said:
Thanks for the reply Tom
looks like this may work. you did well in translating my greater than 0
part. The cells to the right of Col 1 >0 are the ones I wanted formatted
and color based on the Case in ColA. I have created the button from the
controls menu and when I R-Click the button and View code, the code shows
up, but I cannot click the button. What am I doing wrong?
 
D

Dana DeLouis

Just another idea for your Select Case statement:

S = .value
If UCase(S) Like "CASE[123456]" Then
.Offset(0, 1).Resize(1, 7).Interior.ColorIndex = _
99109085 Mod (4 * Right(S, 1) + 13)
End If

HTH
Dana DeLouis


<snip>
 
D

Dana DeLouis

Select Case LCase(.Value)

You are looking for LCase like dog or cat, not Dog, Cat.
Case "dog": ...etc
Case "cat": ...

Forget my other post. I do't know why, but I read it literally.

Dana


Steve said:
Ahhhh.... I was still in design mode, but something is still amiss....

A B C D E
F G H
1 Dog 1 2 4 5 7
2 Fish 7 6 5 4 3 2 1
3 Snake 10 7 1 5 5
4 Cat 19 14 9 4 10 6
5 Bird 25 11 4 3 10 15


Private Sub Commandbutton1_Click()
On Error GoTo ws_exit:
Application.EnableEvents = False
For Each cell In Me.Range("A1:A100")
With cell
If cell.Offset(0, 1).Value > 0 Then
Select Case LCase(.Value)
Case "Dog": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex = 3
Case "Cat": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex = 5
Case "Snake": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex = 10
Case "Bird": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex = 19
Case "Fish": .Offset(0, 1).Resize(1, 7).Interior.ColorIndex = 20
End Select
End If
End With
Next

ws_exit:
Application.EnableEvents = True
End Sub

Right click on my button(1) and view code and I see the code above. When
I click the button, Nothing happens. I want the rows colored by the code,
and in this example D1,G1,B3,F3,C5 would have no color.
 
T

Tom Ogilvy

Private Sub Commandbutton1_Click()
Dim cell as Range
On Error GoTo ws_exit:
Application.EnableEvents = False
For Each cell In Me.Range("A1:A100")
With cell
Select Case LCase(.Value)
Case "dog": ColorCell(cell,3)
Case "cat": ColorCell(cell,5)
Case "snake": ColorCell(cell,10)
Case "bird": ColorCell(cell, 19)
Case "fish": ColorCell(cell, 20)
End Select
End If
End With
Next
ws_exit:
Application.EnableEvents = True
End Sub

function ColorCell(rng as Range,idex as Long)
Dim c as Range
With rng
for each c in .Offset(0, 1).Resize(1, 7)
if c<> "" then
if isnumeric(c) then
if c > 0 then .Interior.ColorIndex = idex
end if
end if
next
End With
End Function
 
T

Tom Ogilvy

Note that 19 is white on my machine, so Bird doesn't show up very well.

There were some problems with the code. Here is a tested version - worked
for me:

Private Sub Commandbutton1_Click()
Dim cell As Range
On Error GoTo ws_exit:
Application.EnableEvents = False
For Each cell In Me.Range("A1:A12")
Select Case LCase(cell.Value)
Case "dog": ColorCell cell, 3
Case "cat": ColorCell cell, 5
Case "snake": ColorCell cell, 10
Case "bird": ColorCell cell, 19
Case "fish": ColorCell cell, 20
End Select
Next
ws_exit:
Application.EnableEvents = True
End Sub

Function ColorCell(rng As Range, idex As Long)
Dim c As Range
With rng
For Each c In .Offset(0, 1).Resize(1, 7)

If c <> "" Then
If IsNumeric(c) Then
If c > 0 Then c.Interior.ColorIndex = idex
End If
End If
Next
End With
End Function
 
G

Guest

Great Thanks so much for your help!
One thing I failed to consider. There are other possible entries for column A that I dont want highlighted which works fine for the first time around. But if one of the given cases is changed to one that should not be highlighted, on click it should have no fill. The range A1:A100 is actually a look up so it will be either the given cases or blank. Is there a case I can use for blank?
 
T

Tom Ogilvy

Use Case Else (no quotes). see below

Private Sub Commandbutton1_Click()
Dim cell As Range
On Error GoTo ws_exit:
Application.EnableEvents = False
For Each cell In Me.Range("A1:A100")
Select Case LCase(cell.Value)
Case "dog": ColorCell cell, 3
Case "cat": ColorCell cell, 5
Case "snake": ColorCell cell, 10
Case "bird": ColorCell cell, 19
Case "fish": ColorCell cell, 20
Case Else : ColorCell cell, -4142
End Select
Next
ws_exit:
Application.EnableEvents = True
End Sub

--
Regards,
Tom Ogilvy


Steve said:
Great Thanks so much for your help!
One thing I failed to consider. There are other possible entries for
column A that I dont want highlighted which works fine for the first time
around. But if one of the given cases is changed to one that should not be
highlighted, on click it should have no fill. The range A1:A100 is actually
a look up so it will be either the given cases or blank. Is there a case I
can use for blank?
 

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

Top