Condtional formatting in VBA help!

S

Simon Lloyd

I am having trouble with CF in VBA it worked fine under the CF with th
3 arguments that is built in to Excel, the code below was kindl
supplied to me to satisfy other criteria that i needed, please chec
the attatched file which has pictures and a short explanation of ho
and what the CF worked on

Simon

Heres the code!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim val
Dim fValid As Boolean
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("I3:AG641")) Is Nothing Then
Do
fValid = False
val = InputBox("Enter Skill Level" & vbCrLf & " 1= In Training"
vbCrLf & " 2= Trained" & vbCrLf & " 3= Can Train Others" & vbCrLf &
4= Delete Colour and Entry" & vbCrLf & "After number entry enter an
letter, " & vbCrLf & "(For option 4 do not enter a letter!)", "Skill
Breakdown and Competencies Entry", "")
If val = "" Then fValid = True
If Len(val) = 2 Then
If Left(val, 1) = 1 Or Left(val, 1) = 2 Or Left(val, 1) = 3 Then
fValid = True
End If
ElseIf Len(val) = 1 Then
If Left(val, 1) = 4 Then fValid = True
End If
If Not fValid Then _
MsgBox "Invalid Entry Try Again!"
Loop Until fValid
With Target
Select Case Left(val, 1)
Case 1:
.Interior.ColorIndex = 48
Case 2:
.Interior.ColorIndex = 41
Case 3:
.Interior.ColorIndex = 43
Case 4:
.Interior.ColorIndex = xlNone
.Value = ""
.Font.Name = "Times New Roman"
Exit Sub
End Select
Select Case Mid(val, 2, 1)
Case Else:
.Value = Mid(val, 2, 1)
.Font.Name = "Wingdings"
End Select
End With
End If

If Intersect(Target, Me.Range("I3:AG641"), ActiveCell.Offset(0, 36)
"") Then
ActiveCell = Selection.ColorIndex = 3
ElseIf Intersect(Target, Me.Range("I3:AG641"), ActiveCell.Offset(0, 36
= ("I$2" * 365) >= Today()) Then
ActiveCell = Selection.ColorIndex = 4
ElseIf Intersect(Target, Me.Range("I:AG641"), ActiveCell.Offset(0, 36
= ("I$2" * 365) < Today()) Then
ActiveCell = Selection.ColorIndex = 5
End If

ws_exit:
Application.EnableEvents = True
End Sub

The if statements at the bottom here are what ive been trying to write
as i said if it did work it would only look at cell I$

Attachment filename: cf help.xls
Download attachment: http://www.excelforum.com/attachment.php?postid=53861
 
Top