Conditional formatting Macro run time error

[apnt81]

Hello - my goal is to have a macro that will colour a cell a certain colour depending on a list of possible words that have been restricted using 'data validation' feature. Using a combination of own knowledge and different websites I have written a macro that works well apart from one thing.

When I copy and paste multiple cells or try to delete multiple cells I get a 'run time error' and I am not sure why.

Can someone please let me know how I need to alter the code to prevent this?

The exact text of the code is copied below:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Integer
If Not Intersect(Target, Range("C11:C65536")) Is Nothing Then
Select Case Target
Case Is = "Project Promoted to GREY in PRISM"
icolor = 15
Case Is = "D&D Completed Work"
icolor = 36
Case Is = "To Be Worked By D&D"
icolor = 35
Case Is = "Holding for Information from Project"
icolor = 38
Case Is = "D&D Work in Progress"
icolor = 40
Case Is = "No Documentation Received"
icolor = 37

Case Is = "No Drawing Updates Required"
icolor = 6

Case Is = "Project Work Cancelled"
icolor = 14

Case Else
End Select

Target.Interior.ColorIndex = icolor
End If
End Sub

Thanks in advance for your help!

Andrew

 

[syntaxed]

Welcome to MrExcel.

The problem arises because when you paste or delete multiple cells in column C, the range "Target" that is passed to the procedure is a range of multiple cells, whereas the Select Case Target statement you are using is assuming a single cell.

You can modify your code to:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Integer
If Not Intersect(Target, Range("C11:C65536")) Is Nothing Then
For Each cell In Target
Select Case cell
Case Is = "Project Promoted to GREY in PRISM"
icolor = 15
Case Is = "D&D Completed Work"
icolor = 36
Case Is = "To Be Worked By D&D"
icolor = 35
Case Is = "Holding for Information from Project"
icolor = 38
Case Is = "D&D Work in Progress"
icolor = 40
Case Is = "No Documentation Received"
icolor = 37
Case Is = "No Drawing Updates Required"
icolor = 6
Case Is = "Project Work Cancelled"
icolor = 14
Case Else
icolor = cell.Interior.ColorIndex
End Select
cell.Interior.ColorIndex = icolor
Next
End If
End Sub