here is the full code, i have added in a row of stars next to the line it is failing at
Private Sub Worksheet_SelectionChange(ByVal Target As range)
'Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.range)
Application.ScreenUpdating = False
If Target.Address(0, 0) = "B3" Then
'
'
'
': ShowIt
range("C12:I56").Interior.ColorIndex = xlNone
range("M12:M56").ClearContents
range("O12:O56").ClearContents
range("Q12:Q56").ClearContents
range("S12:S56").ClearContents
range("U12:U56").ClearContents
range("W12:W56").ClearContents
range("Y12:Y56").ClearContents
End If
'MsgBox Selection.Interior.ColorIndex
'Use the code above if need be to determine the code of the colour
Dim Rng As range, Dn As range
Dim n As Integer
Dim Jobs(1 To 20, 1 To 2)
' alter the "10" (Above) to the number of jobs
'& add to array (below) with proper Job Names and
'your chosen colour index.
Jobs(1, 1) = "Misc": Jobs(1, 2) = 54 'Alter last number (colour Index)as Req'ed from Colour Code
Jobs(2, 1) = "Alpha": Jobs(2, 2) = 43
Jobs(3, 1) = "Urgent Phone": Jobs(3, 2) = 3
Jobs(4, 1) = "Urgent Desk": Jobs(4, 2) = 39
Jobs(5, 1) = "Phones AM, Confs PM": Jobs(5, 2) = 46
Jobs(6, 1) = "Phones PM, Confs AM": Jobs(6, 2) = 40
Jobs(7, 1) = "Reports AM, Confs PM": Jobs(7, 2) = 34
Jobs(8, 1) = "Reports PM, Confs AM": Jobs(8, 2) = 37
Jobs(9, 1) = "Quotes": Jobs(9, 2) = 7
Jobs(10, 1) = "Confs": Jobs(10, 2) = 36
Jobs(11, 1) = "Client Advice": Jobs(11, 2) = 38
Jobs(12, 1) = "Seniors": Jobs(12, 2) = 10
Jobs(13, 1) = "Problem Line AM": Jobs(13, 2) = 15
Jobs(14, 1) = "Problem Line PM": Jobs(14, 2) = 48
Jobs(15, 1) = "Report AM": Jobs(15, 2) = 42
Jobs(16, 1) = "Report PM": Jobs(16, 2) = 33
Jobs(17, 1) = "Phones AM": Jobs(17, 2) = 4
Jobs(18, 1) = "Phones PM": Jobs(18, 2) = 50
Jobs(19, 1) = "Office Co-Ord": Jobs(19, 2) = 12
Jobs(20, 1) = "Office Manager": Jobs(20, 2) = 6
Set Rng = range("C12:C56")
For Each Dn In Rng
For n = 1 To UBound(Jobs)
If Dn.Interior.ColorIndex = Jobs(n, 2) Then
Dn.Offset(, 10) = Jobs(n, 1)
ElseIf Dn.Interior.ColorIndex = -4142 Then
Dn.Offset(, 10) = vbNullString*************************************
Exit For
End If
Next n
Next Dn
Set Rng = range("D12:D56")
For Each Dn In Rng
For n = 1 To UBound(Jobs)
If Dn.Interior.ColorIndex = Jobs(n, 2) Then
Dn.Offset(, 11) = Jobs(n, 1)
ElseIf Dn.Interior.ColorIndex = -4142 Then
Dn.Offset(, 11) = vbNullString
Exit For
End If
Next n
Next Dn
Set Rng = range("E12:E56")
For Each Dn In Rng
For n = 1 To UBound(Jobs)
If Dn.Interior.ColorIndex = Jobs(n, 2) Then
Dn.Offset(, 12) = Jobs(n, 1)
ElseIf Dn.Interior.ColorIndex = -4142 Then
Dn.Offset(, 12) = vbNullString
Exit For
End If
Next n
Next Dn
Set Rng = range("F12:F56")
For Each Dn In Rng
For n = 1 To UBound(Jobs)
If Dn.Interior.ColorIndex = Jobs(n, 2) Then
Dn.Offset(, 13) = Jobs(n, 1)
ElseIf Dn.Interior.ColorIndex = -4142 Then
Dn.Offset(, 13) = vbNullString
Exit For
End If
Next n
Next Dn
Set Rng = range("G12:G56")
For Each Dn In Rng
For n = 1 To UBound(Jobs)
If Dn.Interior.ColorIndex = Jobs(n, 2) Then
Dn.Offset(, 14) = Jobs(n, 1)
ElseIf Dn.Interior.ColorIndex = -4142 Then
Dn.Offset(, 14) = vbNullString
Exit For
End If
Next n
Next Dn
Set Rng = range("H12:H56")
For Each Dn In Rng
For n = 1 To UBound(Jobs)
If Dn.Interior.ColorIndex = Jobs(n, 2) Then
Dn.Offset(, 15) = Jobs(n, 1)
ElseIf Dn.Interior.ColorIndex = -4142 Then
Dn.Offset(, 15) = vbNullString
Exit For
End If
Next n
Next Dn
Set Rng = range("I12:I56")
For Each Dn In Rng
For n = 1 To UBound(Jobs)
If Dn.Interior.ColorIndex = Jobs(n, 2) Then
Dn.Offset(, 16) = Jobs(n, 1)
ElseIf Dn.Interior.ColorIndex = -4142 Then
Dn.Offset(, 16) = vbNullString
Exit For
End If
Next n
Next Dn
Application.ScreenUpdating = True
End Sub