VBA Type Mismatch When Deleting Multiple Cell Value

Bonjour_Rodney · 20 Jun 2008 at 11:49

I have a spreadsheet that uses VBA to change cell colours depending on the value in them. The possible value that can be entered into these cells are picked up from a validation range and selected from drop down list boxes.

The code works fine for everything excpet when deleting from multiple cells at once. Eg, if I delete from cell C8 the value disapears and the cell colour returns to no fill. However, if I select cells C8 & C9, hit delete I get the following error:

Runtime error 13

Type mismatch.

Here is the code for you all to have a peek at.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iColour As Integer
   
    'January
    If Not Intersect(Target, Range("rJan")) Is Nothing Then
        
        Call colourCell(Target)
      
    End If
    
           
End Sub


Public Sub colourCell(Target)
    
      Select Case Target
            Case "BH"
                iColour = 6     'Yellow:        Bank Holiday
            Case "BW"
                iColour = 46    'Orange:        Bank Holiday Working
            Case "H"
                iColour = 39    'Lavender:      Holiday Lieu Day
            Case "S"
                iColour = 38    'Rose:          Sick
            Case "OO"
                iColour = 35    'Light Green:   Out of The Office
            Case "TO"
                iColour = 7     'Pink:          Time Owed
            Case "TB"
                iColour = 5     'Blue:          Time Bank
            Case Else
                'Whatever
        End Select
        
        Target.Interior.ColorIndex = iColour
    
End Sub

Many thanks in advance for any help :confused:

dan^uk · 20 Jun 2008 at 18:16

I haven't tried this code, but it would be something like:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iColour As Integer
Dim cell As Range
   
    'January
    If Not Intersect(Target, Range("rJan")) Is Nothing Then
        
        For Each cell In Target
 	  Call colourCell(cell)
	Next cell
      
    End If
End Sub

If that doesn't work, it would be easier if you posted the spreadsheet to find the problem.

Bonjour_Rodney · 22 Jun 2008 at 12:03

Arghhh

No it still doesn't work. How do I post the spreadsheet to you?

Bonjour_Rodney · 24 Jun 2008 at 08:41

This is driving me nuts, any suggestions would be greatly appreciated.

Haircut · 24 Jun 2008 at 10:56

Where exactly is the error occurring?
Can you post a link to a copy of the spreadsheet?

With some more details we might be better placed to help you.

SimonCHere · 26 Jun 2008 at 18:11

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iColour As Integer
Dim cell As Range
   
    'January
    If Not Intersect(Target, Range("rJan")) Is Nothing Then
        
        For Each cell In Target.Cells
 	  Call colourCell(cell)
        Next
      
    End If
End Sub

You forgot the .Cells bit!

Simon