Change color

[fad1959]

Can I add code to the first 4 Case Statemnets below, so they will change color when selected on worksheet

Private Sub Worksheet_Change(ByVal Target As Range)

Dim strNow As String
Dim rowTgt As Long
Dim valTgt
Dim ws As Worksheet
Dim rngC As Range
Dim rngD As Range
Dim SaveFlag As Boolean

If Target.Column <> 2 Then
Exit Sub
End If

If Target.Row < 3 Or Target.Row > 30 Then
Exit Sub
End If

SaveFlag = True
strNow = Format(Now(), "hh:mm:ss AMPM")

rowTgt = Target.Row

Set ws = Sheets("Sheet1")
Set rngC = ws.Range("C" & rowTgt)
Set rngD = ws.Range("D" & rowTgt)

valTgt = Target.Value

Select Case valTgt

Case "IN OFFICE" rngD = strNow
rngC = ""
Case "Depart Lunch/Road Sup", "Out Of Office"
rngC = strNow
Case "Return Lunch/Road Sup", "Return From Meeting", "Return From Lunch"
rngD = strNow
Case "Out For Lunch" rngC = strNow
rngD = ""
Case Else
rngC = ""
rngD = ""
SaveFlag = False

End Select

If SaveFlag Then
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.DisplayAlerts = True
End If
End Sub

 

[Nimrod]

Private Sub Worksheet_Change(ByVal Target As Range)

Dim strNow As String
Dim SaveFlag As Boolean


If Not Application.Intersect(Range("B3:B30"), _
Range(Target.Address)) Is Nothing Then

SaveFlag = True
strNow = Format(Now(), "hh:mm:ss AMPM")

With Target
Select Case .Value

Case "IN OFFICE"
.Interior.ColorIndex = 6
.Offset(0, 2).Value = strNow
.Offset(0, 1).Value = ""

Case "Depart Lunch/Road Sup", "Out Of Office"
.Interior.ColorIndex = 4
.Offset(0, 1).Value = strNow

Case "Return Lunch/Road Sup", "Return From Meeting", "Return From Lunch"
.Interior.ColorIndex = 3
.Offset(0, 2).Value = strNow

Case "Out For Lunch"
.Interior.ColorIndex = 8
.Offset(0, 1).Value = strNow
.Offset(0, 2).Value = ""

Case Else
.Offset(0, 1).Value = ""
.Offset(0, 2).Value = ""
SaveFlag = False
.Interior.ColorIndex = 0
End Select

If SaveFlag Then
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.DisplayAlerts = True
End If
End With
End If
End Sub

:-> HINT : To get the colors you want just start the macro recorder and record your color fillins .. then stop and look at code .. :wink:

 

[fad1959]

Thank you

works great