Shorten Code?

  • Thread starter Thread starter Rockee052
  • Start date Start date
R

Rockee052

Hi,

Yes, it's me again... Patrick helped me out with this code earlie
(Thanks again). I added a few things and the code works okay(wow),
just think it can be simplified and am not sure how. I used the selec
method to check if cells where selected and if so a message box wil
display. The problem is it does what is says "selects" the cells, the
does some weird scroll around selecting all the cells. So, does anyon
have any ideas on what method I should be using???

I might as well stay up all night, have to go to work in 2 hrs :)

Private Sub Worksheet_BeforeRightClick(ByVal Target As _
Range, Cancel As Boolean)
Dim myOffset As Long

If ActiveSheet.ProtectContents = True Then
ActiveSheet.Unprotect Password:="sleep"
End If

' Selecting ranges that cannot not be cleared
If Range("B11:B20").Select Then
If Range("B30:B39").Select Then
If Range("B49:B66").Select Then
If Range("G11:G20").Select Then
If Range("G30:G39").Select Then
If Range("G49:G66").Select Then
If Range("L11:L20").Select Then
If Range("L30:L39").Select Then
If Range("L49:L66").Select Then
If Range("Q11:Q20").Select Then
If Range("Q30:Q39").Select Then
If Range("Q49:Q66").Select Then

MsgBox "You cannot delete the contents of this cell", , _
"You do not have permission!"
Range("B6").Select
Exit Sub
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If

' Selecting columns to delete
Select Case Target.Column
Case 2
myOffset = 4
Case 12
myOffset = 5
Case 7
myOffset = 6
Case 17
myOffset = 7
Case Else
End Select
If myOffset > 0 Then
Cancel = True
Target.Value = ""
Target.Offset(0, myOffset).Value = ""
End If

'Reenable protection
If ActiveSheet.ProtectContents = False Then
ActiveSheet.Protect Password:="sleep"
End If

End Sub

Thanks

Rockee Freema
 
Actually, you can not check if a cell is selected with the select
method. It would select the range anyway.
I would check it with "Selection.Address".
 
Rockee,

I had a problem with your code, I couldn't get past the error message box.
If I understand what you are trying to do, this should do it

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As
Boolean)
Dim myOffset As Long
Dim rng As Range

Set rng =
Range("B11:B20,B30:B39,B49:B66,G11:G20,G30:G39,G49:G66,L11:L20,L30:L39,L49:L
66,Q11:Q20,Q30:Q39,Q49:Q66")
If ActiveSheet.ProtectContents = True Then
ActiveSheet.Unprotect Password:="sleep"
End If

' Selecting ranges that cannot not be cleared
If Not Intersect(Target, rng) Is Nothing Then
MsgBox "You cannot delete the contents of this cell", , _
"You do not have permission!"
Range("B6").Select
Else
' Selecting columns to delete
Select Case Target.Column
Case 2
myOffset = 4
Case 12
myOffset = 5
Case 7
myOffset = 6
Case 17
myOffset = 7
Case Else
End Select
If myOffset > 0 Then
Cancel = True
Target.Value = ""
Target.Offset(0, myOffset).Value = ""
End If
End If

'Reenable protection
If ActiveSheet.ProtectContents = False Then
ActiveSheet.Protect Password:="sleep"
End If

End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Rockee,

Just a little shorter.

You don't need to check If ActiveSheet.ProtectContents = False
at the end, as your code will always ensure protection is off.
All you need is:
'Re-enable protection
ActiveSheet.Protect Password:="sleep"
End Sub

HTH
Henry
 
Back
Top