Changing Cell Pattern\Color based on length of text in cell.

[dhosi439]

I have a shift schedule setup. Each half hour is marked by a single character, either an l or t.

I am trying to use VBA to change the cell pattern/colors. If a user inputs more than one character the code will change the cell formatting. I would also like for it to prompt the user that they have entered invalid characters, not sure where the best spot for this would be.

Here is my code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim C As Range

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("MondaySchedule")) Is Nothing Then
    For Each C In Target
        If Not (Target = 0) Then
            If Len(Trim(C)) > 1 Then
                With C.Interior
                    .Color = RGB(0, 0, 255)
                    .Pattern = xlPatternHorizontal
                    .PatternColor = RGB(0, 255, 0)
                End With
            End If
        
          '  MsgBox "Multiple Characters in Cell!"
          '  Exit Sub
 
        End If
    Next cell
End If

ws_exit:
Application.EnableEvents = True
End Sub

Note: "MondaySchedule" refers to a named range of "C5:S10"

Absolutely nothing happens. I don't know what I am missing. Any help would be appreciated.

 

[SteveO59L]

Why cant you use native Conditional Formatting?

 

[dhosi439]

I can and I have that working, however I can't setup a prompt in Conditional Formating. This is my primary reason for going with VBA for this issue. I don't even need to format the cells in VBA I just need it to check if there is more then one character in a cell and then tell the user.

 

[SteveO59L]

something along the lines of

dim c as range, rng
set rng=range("a1:z100")
for each c in rng
if len(c)>1 then
msgbox "morethan 1 character in cell "c.address
end if
next c

 

[dhosi439]

I prefer using named ranges and this code does work elsewhere, I may not be referencing my Len formula correctly.

Here is my new code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cell As Range

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("MondaySchedule")) Is Nothing Then
    For Each cell In Target
        If Not (Target = 0) Then
            If Len(cell) > 1 Then
                MsgBox "Multiple Characters in Cell!"
            End If
        End If
    Next cell
End If

ws_exit:
Application.EnableEvents = True
End Sub