Need to protect formulas but problem with SelectionChange code

[Pauljj]

Hello Excellers I have VB code that does some trickery when users select a cell...all works fine but in a certain range where they are required to format the cells, there are formulas.

I need to be able to protect those formulas whilst allowing the user to format the cells

I have version 2003 and I have added the ability to format the cells as an option but the code which exists in the code which is

Private Sub Worksheet_SelectionChange(ByVal Target As range)

part of the above is causing an error which says

Run time error 1004

Application Defined or Object Defined Error


Can anyone think of a workaround please ?

 

[Joe4]

Can you post your entire code, and indicate which line is causing the error (if you click Debug, it should highlight the offending line)?

 

[Pauljj]

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

 

[Joe4]

You obviously have a lot going on there, so I don't even pretend to understand what you are trying to do, but here a few things which may help:

1. Regarding your error, I don't see anything wrong with your code line that is returning the error, unless you are trying to update some cell which is protected.

2. Your line:

If Target.Address(0, 0) = "B3" Then

may not work for you. I think you may need to change it to this:

If Target.Address(0, 0) = "$B$3" Then

(if you do a MsgBox Target.Address, you will see that is how VBA returns range names).
One way guaranteed to work is this:

If Target.Address(0, 0) = Range("B3").Address Then

3. When posting code in the future, can you use CODE tags? It makes code much easier to read, as it keeps all identations, etc.

 

[Pauljj]

Thanks for this Joe, I will take a look at your suggestions. Thanks for getting back to me