VBA for CF for 6 conditions in Excel2003

[asad]

Hello guys,

I got a VBA code from this forum long time back for CF in 2003. But I needed to change it and when I did it stopped working. Now I am stuck again with no clue how to write it. The conditions I need are:

• If A1="OFF", then font is bold & black and cell colour is light green
• If A1="RDO", then font is bold and blue and cell colour is light yellow
• If A1=or(1,2,4,128,130,136,138), then font is normal and black but cell colour is orange
• I need this to be as my fourth condition, =mod(ROW(),2)=1 with pattern selected to be light grey
• If A1<>AA1, then font is Bold and Red and cell colour stays with the mod formula above
• If A1 then change back to be equal to AA1, then font should go back to normal and black unless it is one of first three conditions in which case those formats should kick in.

I done it in 2007 at home but can't do it at work because we got 2003 over there. Hence the requirement for VBA.
Can somebody please give me the code as I can't write VBA codes myself?
Thanks in advance
Asad

 

[asad]

I have changed my previous code to the following:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
On Error GoTo Handler
Application.EnableEvents = False

Set rng = Intersect(Target, Range("A1:F100"))

If rng Is Nothing Then
GoTo My_Exit
Else
For Each c In rng
Select Case c.Value
Case "OFF"
c.Interior.ColorIndex = 35
c.Font.Bold = True
Case "RDO"
c.Interior.ColorIndex = 36
c.Font.Bold = True
Case "2", "4", "128"
c.Interior.ColorIndex = 22
Case Else
c.Interior.ColorIndex = xlNone
End Select
Next c
End If
My_Exit:
Application.EnableEvents = True
Exit Sub
Handler:
MsgBox "Error in Worksheet Change Event Code: " & Err.Description
Resume My_Exit
End Sub

But I don't know how to include my =mod(row(),2)=1 condition in this.
I tried to put this condition using CF but then it stops the other conditions like the one for OFF or RDO to put the desired colour in cell.
Can you please help me to solve this problem?

Asad

 

[asad]

.

 

[asad]

I tried to add this code

Case c.Value <> c.Offset(, 11)
                    c.Font.ColorIndex = 3
                    c.Font.Bold = True

But it doesn't work.
What should I change in this to make it work?
Also, I saw mr VOG's code

Sub ShadeEveryOtherRow()
Dim Counter As Long
'For every row in the current selection...
For Counter = 1 To Selection.Rows.Count
    'If the row is an odd number (within the selection)...
    If Counter Mod 2 = 1 Then
    'Set the pattern to colorindex 15
        Selection.Rows(Counter).Interior.ColorIndex = 15
    End If
Next Counter
End Sub

in this forum on thread http://www.mrexcel.com/forum/showthread.php?t=447534&highlight=shading+alternate+rows

How can I incorporate it in my code in my post #2?

Asad

 

[asad]

Also, when I try to use my code in post #2, as a worksheet activate code, it doesn't do anyhting at all.
Any suggestions there?

Asad
P.S.: I am posting it here as well:

Private Sub Worksheet_Activate()
Dim rng As Range, c As Range
On Error GoTo Handler
Application.EnableEvents = False
    
    Set rng = Intersect(Target, Range("A1:E20"))
    
    If rng Is Nothing Then
        GoTo My_Exit
    Else
        For Each c In rng
            Select Case c.Value
                Case "OFF"
                    c.Interior.ColorIndex = 35
                    c.Font.Bold = True
                Case "RDO"
                    c.Interior.ColorIndex = 36
                    c.Font.Bold = True
                Case "2", "128", "130"
                    c.Interior.ColorIndex = 22
                Case c.Value <> c.Offset(, 11)
                    c.Font.ColorIndex = 3
                    c.Font.Bold = True
                Case Else
                    c.Interior.ColorIndex = xlNone
            End Select
        Next c
    End If
My_Exit:
Application.EnableEvents = True
Exit Sub
Handler:
MsgBox "Error in Worksheet Change Event Code: " & Err.Description
Resume My_Exit
End Sub

 

[asad]

Bump.

 

[asad]

Any help please?

 

[asad]

 

[asad]

I got the following code doing half the job I wanted it to do:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
On Error GoTo Handler
Application.EnableEvents = False

Set rng = Intersect(Target, Range("I4:BC200"))

If rng Is Nothing Then
GoTo My_Exit
Else
For Each c In rng
Select Case c.Value
Case "RDO"
c.Interior.ColorIndex = 19
Case "OFF"
c.Interior.ColorIndex = 35
Case "1,2,4,128,139,142,143,145,749"
c.Interior.ColorIndex = 45
Case Else
c.Interior.ColorIndex = xlNone
End Select
Next c

End If

My_Exit:
Application.EnableEvents = True
Exit Sub
Handler:
MsgBox "Error in Worksheet Change Event Code: " & Err.Description
Resume My_Exit
End Sub

With this code, it does not format all the cells that already has a value in them. If I type in a new value within the range, it does th formatting otherwise it doesn't do anything.
Also, I want to include another line of code that will make alternate rows grey in colour within the range if they do not any criteria form the ones above.

Asad

 

[asad]

Ok, I got it to work for me. But is there another way to write this code?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Dim Counter As Long
For Counter = 1 To Selection.Rows.Count
If Counter Mod 2 = 1 Then
Selection.Rows(Counter).Interior.ColorIndex = 15
End If
Next Counter
On Error GoTo Handler
Application.EnableEvents = False
    
    Set rng = Intersect(Target, Range("I4:BC200"))
    
    If rng Is Nothing Then
        GoTo My_Exit
    Else
        For Each c In rng
            Select Case c.Value
                Case "RDO"
                    c.Interior.ColorIndex = 19
                    c.Font.ColorIndex = 41
                    c.Font.Bold = True
                Case "OFF"
                    c.Interior.ColorIndex = 35
                Case "1", "2", "4", "128", "139", "142", "143", "145", "749"
                    c.Interior.ColorIndex = 45
                
            End Select
        Next c
        
    End If
    
My_Exit:
Application.EnableEvents = True
Exit Sub
Handler:
MsgBox "Error in Worksheet Change Event Code: " & Err.Description
Resume My_Exit
End Sub