Case Select


G

Guest

Hi
Im new to VB and I am trying to modify some one else's code.
The code colors the cells according to the cell contents in ColZ. However
if Z is blank the code stops. If Z is blank I would like the cell to be
clear. How do I add the case for blank?

Private Sub Commandbutton1_Click()
Dim cell As Range
On Error GoTo ws_exit:
Application.EnableEvents = False
For Each cell In Me.Range("z5:z36")
Select Case LCase(cell.Value)
Case "cat": ColorCell cell, 39
Case "dog": ColorCell cell, 35
Case "fish": ColorCell cell, 34
Case "horse": ColorCell cell, 36
Case Else: ColorCell cell, -4142

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, -24).Resize(1, 24)

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


Thanks
Bill
 
Ad

Advertisements

L

Lonnie M.

Hi, try this:

For Each cell In Me.Range("z5:z36")
Select Case LCase(cell.Value)
Case "cat": ColorCell cell, 39
Case "dog": ColorCell cell, 35
Case "fish": ColorCell cell, 34
Case "horse": ColorCell cell, 36
Case "": ColorCell cell, 0
Case Else: ColorCell cell, -4142
End Select
Next

HTH--Lonnie M.
 
B

Bob Phillips

Bill,

Doesn't stop for me. I had yellow cells in V5, W5, and X5 and Z5 was empty,
and it cleared them nicely.

--

HTH

RP
(remove nothere from the email address if mailing direct)
 
G

Guest

Brain cramp!!!!!---The cells were negative! How would I modify Case for
"CAT" and negative.
Thanks!
 
B

Bob Phillips

Which part? The case else handles negatives.

--

HTH

RP
(remove nothere from the email address if mailing direct)
 
Ad

Advertisements

H

Himszy

Where do you get codes for the colours?

Bob Phillips said:
Which part? The case else handles negatives.

--

HTH

RP
(remove nothere from the email address if mailing direct)


to
 
G

Guest

Values for "CAT" and be positive, negative. In this case I only want to
shade the negative cells. In a manner of speaking adding an AND to the case
statement. Cell =CAT and < 0 is shaded.
Thanks!
 
B

Bob Phillips

Private Sub Commandbutton1_Click()
Dim cell As Range
On Error GoTo ws_exit:
Application.EnableEvents = False
For Each cell In Me.Range("z5:z36")
Select Case LCase(cell.Value)
Case "cat": ColorCell Case(cell.Value),cell, 39
Case "dog": ColorCell Case(cell.Value),cell, 35
Case "fish": ColorCell Case(cell.Value),cell, 34
Case "horse": ColorCell Case(cell.Value),cell, 36
Case Else: ColorCell Case(cell.Value),cell, -4142

End Select
Next
ws_exit:
Application.EnableEvents = True
End Sub

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

If c <> "" Then
If IsNumeric(c) Then
If (val = "cat" And c < 0) Or _
c > 0 Then c.Interior.ColorIndex = idex
End If
End If
Next
End With
End Function



--

HTH

RP
(remove nothere from the email address if mailing direct)
 
Ad

Advertisements

B

Bob Phillips

Typo, that should be

Private Sub Commandbutton1_Click()
Dim cell As Range
On Error GoTo ws_exit:
Application.EnableEvents = False
For Each cell In Me.Range("z5:z36")
Select Case LCase(cell.Value)
Case "cat": ColorCell LCase(cell.Value),cell, 39
Case "dog": ColorCell LCase(cell.Value),cell, 35
Case "fish": ColorCell LCase(cell.Value),cell, 34
Case "horse": ColorCell LCase(cell.Value),cell, 36
Case Else: ColorCell LCase(cell.Value),cell, -4142

End Select
Next
ws_exit:
Application.EnableEvents = True
End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)
 
Ad

Advertisements


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

Case Select 6
Select Case 0
Select Case 13
Select Case 6
Select Case 4
Select case or If then 3
Select Case 6
Select Case 5

Top