Applying VBA Formatting to a selected range of cells with Validation

[Legacy 102432]

Hi,

I am not a genius on VBA and I have only recently started teaching myself a thing or two about it. Basically what I needed to do was apply more than 3 conditional formats to a range of cells.

I have drop down cells that represent the "Status" for Projects that I am working on.. I have 5 Status options that I want to be able to choose from, and when these are selected, I want the background of the cell to change colour as below:

When user selects:
Ongoing = Yellow
Not Started = Grey
On Schedule = Orange
Behind = Red
Completed = Green

I copied this VBA code from the internet that allows me to do this:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Integer
If Not Intersect(Target, Range("E7:E14")) Is Nothing Then
Select Case Target
Case ""
icolor = 2
Case "Ongoing"
icolor = 6
Case "Not Started"
icolor = 15
Case "On Schedule"
icolor = 45
Case "Behind"
icolor = 3
Case "Completed"
icolor = 4
Case Else
'Whatever
End Select

Target.Interior.ColorIndex = icolor
End If

End Sub



My only problem is that if someone highlights more than one cell in that range and hits the delete key, I get an error message

"Run-time error '13':

Type mismatch"

Then the option to either End or Debug.

It will only allow the user to delete the contents of the cell individually. Is there a way to stop this error message from appearing?

Any help would be appreciated!

 

[lenze]

Hi and welcome to the board!!!

Make this the 1st line of your code

If Target.Count > 1 Then Exit Sub

Also, you can write your cases like this

Case "Completed":iColor = 4

Saves space and easier to read

lenze

 

[Legacy 102432]

Hi and welcome to the board!!!

Make this the 1st line of your code

If Target.Count > 1 Then Exit Sub

Thanks that stops the error message, but the background colour for the cells remain. How do I keep the background white after the user has deleted the contents?

 

[lenze]

Mabe this will help?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Variant
If Intersect(Target, Range("E7:E14")) Is Nothing Then Exit Sub
Select Case Target.Count
Case 1
    Select Case Target
        Case "": icolor = xlNone
        Case "Ongoing": icolor = 6
        Case "Not Started": icolor = 15
        Case "On Schedule": icolor = 45
        Case "Behind": icolor = 3
        Case "Completed": icolor = 4
        Case Else 'Whatever
    End Select
    Target.Interior.ColorIndex = icolor
Case Else: Target.Interior.ColorIndex = xlNone
End Select
End Sub

lenze