Need to protect formulas but problem with SelectionChange code

Pauljj

Well-known Member
Joined
Mar 28, 2004
Messages
2,047
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 ?
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Can you post your entire code, and indicate which line is causing the error (if you click Debug, it should highlight the offending line)?
 
Upvote 0
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
 
Upvote 0
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:
Code:
If Target.Address(0, 0) = "B3" Then
may not work for you. I think you may need to change it to this:
Code:
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:
Code:
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.
 
Upvote 0
Thanks for this Joe, I will take a look at your suggestions. Thanks for getting back to me
 
Upvote 0

Forum statistics

Threads
1,224,502
Messages
6,179,126
Members
452,890
Latest member
Nikhil Ramesh

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top