Excel Runtime error 13 Colour formatting

[kitackers]

I've got a workbook with the enclosed code embedded to each worksheet, which format the cells depending on the data entered (I know the code isn't too tidy, I'm only doing this as a favour!!). When more than one cell is selected and data is deleted, I get a Runtime error 13, type mismatch. Gone through the various threads aren't can't find anything

Private Sub Worksheet_Change(ByVal Target As Range)

Dim icolor As Integer

If Not Intersect(Target, Range("e7:BN26")) Is Nothing Then
Select Case Target

Case ""
icolor = 2
Case "t"
icolor = 4
Case "T"
icolor = 4
Case "sd"
icolor = 24
Case "SD"
icolor = 24
Case "p"
icolor = 35
Case "P"
icolor = 35
Case "ob"
icolor = 3
Case "OB"
icolor = 3
Case "op"
icolor = 44
Case "OP"
icolor = 44
Case "o"
icolor = 26
Case "O"
icolor = 26
Case "c"
icolor = 34
Case "C"
icolor = 34
Case "s"
icolor = 36
Case "S"
icolor = 36
Case "h"
icolor = 28
Case "H"
icolor = 28

Case Else
End Select
Target.Interior.ColorIndex = icolor
End If

End Sub

 

[SkipVought]

Hi,

Try this

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim iColor As Integer
'[b]
'When more than one cell is selected and data is deleted, I get a Runtime error
    If Target.Count > 1 Then Exit Sub
'[/b]
    If Not Intersect(Target, Range("e7:BN26")) Is Nothing Then
        Select Case UCase(Target.Value)
            Case ""
                iColor = 2
            Case "t"
                iColor = 4
            Case "SD"
                iColor = 24
            Case "P"
                iColor = 35
            Case "OB"
                iColor = 3
            Case "OP"
                iColor = 44
            Case "O"
                iColor = 26
            Case "C"
                iColor = 34
            Case "S"
                iColor = 36
            Case "H"
                iColor = 28
        End Select
        Target.Interior.ColorIndex = iColor
    End If

End Sub

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[kitackers]

Brilliant.

Much appreciated (feel guilty about being so lazy with my code sometimes!!)

 

[SkipVought]

oops! Missed the UPPERCASE T.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[kitackers]

Good spot!

 

[SkipVought]

BTW, If you what to ptocess changes made with a multiple Target range...

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim iColor As Integer, t As Range
    
    For Each t In Target
        If Not Intersect(t, Range("e7:BN26")) Is Nothing Then
            Select Case UCase(t.Value)
                Case ""
                    iColor = 2
                Case "T"
                    iColor = 4
                Case "SD"
                    iColor = 24
                Case "P"
                    iColor = 35
                Case "OB"
                    iColor = 3
                Case "OP"
                    iColor = 44
                Case "O"
                    iColor = 26
                Case "C"
                    iColor = 34
                Case "S"
                    iColor = 36
                Case "H"
                    iColor = 28
            End Select
            Target.Interior.ColorIndex = iColor
        End If
    Next
End Sub

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]