I have a countcolor USf add-in but whenever I highlight a selected range for the countcolor function it will not let me format the cell colors through my work_sheet change sub.
Here is my countcolor add-in:
Function CountColor(Rng As Range, RngColor As Range) As Integer
Dim Cll As Range
Dim Clr As Long
Clr = RngColor.Range("A1").Interior.ColorIndex
For Each Cll In Rng
If Cll.Interior.ColorIndex = Clr Then
CountColor = CountColor + 1
End If
Next Cll
End Function
and here is my work_sheet change
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C13:GB38"
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
Select Case .Value
Case Empty:
.Interior.ColorIndex = 0
Case "Holiday":
.Interior.ColorIndex = 4 'Green
.Font.ColorIndex = 4
Case "Ill/sick":
.Interior.ColorIndex = 3 'red
.Font.ColorIndex = 3
Case "Shift":
.Interior.ColorIndex = 8 'turquoise
.Font.ColorIndex = 8
Case "S.Ph":
.Interior.ColorIndex = 39 'lavendar
.Font.ColorIndex = 39
Case "ResSup":
.Interior.ColorIndex = 16 'grey
.Font.ColorIndex = 16
Case "TrRec"
.Interior.ColorIndex = 38 'rose
.Font.ColorIndex = 38
Case "KPG"
.Interior.ColorIndex = 53 'brown
.Font.ColorIndex = 53
Case "KPR"
.Interior.ColorIndex = 34 'light turquoise
.Font.ColorIndex = 34
Case "Project"
.Interior.ColorIndex = 6 'yellow
.Font.ColorIndex = 6
Case "O.S.S"
.Interior.ColorIndex = 50 'sea green
.Font.ColorIndex = 50
Case "Travel"
.Interior.ColorIndex = 40 'tan
.Font.ColorIndex = 40
End Select
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
Thank you!
Here is my countcolor add-in:
Function CountColor(Rng As Range, RngColor As Range) As Integer
Dim Cll As Range
Dim Clr As Long
Clr = RngColor.Range("A1").Interior.ColorIndex
For Each Cll In Rng
If Cll.Interior.ColorIndex = Clr Then
CountColor = CountColor + 1
End If
Next Cll
End Function
and here is my work_sheet change
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C13:GB38"
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
Select Case .Value
Case Empty:
.Interior.ColorIndex = 0
Case "Holiday":
.Interior.ColorIndex = 4 'Green
.Font.ColorIndex = 4
Case "Ill/sick":
.Interior.ColorIndex = 3 'red
.Font.ColorIndex = 3
Case "Shift":
.Interior.ColorIndex = 8 'turquoise
.Font.ColorIndex = 8
Case "S.Ph":
.Interior.ColorIndex = 39 'lavendar
.Font.ColorIndex = 39
Case "ResSup":
.Interior.ColorIndex = 16 'grey
.Font.ColorIndex = 16
Case "TrRec"
.Interior.ColorIndex = 38 'rose
.Font.ColorIndex = 38
Case "KPG"
.Interior.ColorIndex = 53 'brown
.Font.ColorIndex = 53
Case "KPR"
.Interior.ColorIndex = 34 'light turquoise
.Font.ColorIndex = 34
Case "Project"
.Interior.ColorIndex = 6 'yellow
.Font.ColorIndex = 6
Case "O.S.S"
.Interior.ColorIndex = 50 'sea green
.Font.ColorIndex = 50
Case "Travel"
.Interior.ColorIndex = 40 'tan
.Font.ColorIndex = 40
End Select
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
Thank you!