Cell change by selection Error

pingme89

Board Regular
Joined
Jan 23, 2014
Messages
170
Office Version
  1. 365
Platform
  1. Windows
I have the following code that won't work.

Ideally, I would like for any cell in column Q in the chart to toggle values from "" to "P" upon selection. Also I need Range("L5") to toggle 5 different values upon selection

Please see code below.
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Protect UserInterfaceOnly:=True


    With Target
        If Intersect(.Cells, Columns(17)) Is Nothing Or Intersect(.Cells, Worksheets("Sheet1").Range("L5")) Is Nothing Or .Count > 1 Then Exit Sub
        Select Case .Value
        Case ""
            Worksheets(1).Unprotect Password:=""
            .Value = "P"
            Worksheets(1).Protect Password:=""
        Case "P"
           Worksheets(1).Unprotect Password:=""
           .Value = ""
           Worksheets(1).Protect Password:=""
        Case "Store Pick-up"
            Worksheets(1).Unprotect Password:=""
            .Value = "HQ Shipping"
            Worksheets(1).Protect Password:=""
        Case "HQ Shipping"
           Worksheets(1).Unprotect Password:=""
           .Value = "Store Shipping"
           Worksheets(1).Protect Password:=""
        Case "Store Shipping"
           Worksheets(1).Unprotect Password:=""
           .Value = "Supplier Drop Ship"
           Worksheets(1).Protect Password:=""
        Case "Supplier Drop Ship"
           Worksheets(1).Unprotect Password:=""
           .Value = "Store Pick-up"
           Worksheets(1).Protect Password:=""
           Exit Sub
        Case Else
            Exit Sub
        End Select
        
    End With
    Cancel = True


Application.EnableEvents = True


Worksheets(1).Protect Password:=""


End Sub

Any help on why this isn't working would be greatly appreciated.

Thanks in advance.
 
Last edited by a moderator:

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
How about
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("Q:Q")) Is Nothing Then
      Me.Unprotect
      Application.EnableEvents = False
      Target.Value = IIf(Target.Value = "", "P", "")
      Application.EnableEvents = True
      Me.Protect
   ElseIf Target.Address(0, 0) = "L5" Then
      Me.Unprotect
      Application.EnableEvents = False
      Select Case Target.Value
         Case "Store Pick-up":      Target.Value = "HQ Shipping"
         Case "HQ Shipping":        Target.Value = "Store Shipping"
         Case "Store Shipping":     Target.Value = "Supplier Drop Ship"
         Case "Supplier Drop Ship": Target.Value = "Store Pick-up"
      End Select
      Me.Protect
      Application.EnableEvents = True
   End If
End Sub
 
Upvote 0
That worked like a charm!!! Thanks a million. At my work PC that code crashed Excel. But the problem was not your code, it was the crappy PC my company gave me. 9 years old and only 4 GB of Ram. I just tried it on my home PC. Really good code. Thanks again.
 
Upvote 0
I have one question. In your code, you wrote "If Not Intersect(Target, Range("Q:Q")) Is Nothing Then"

That allows a user to click anywhere in column Q. Is there a way to restrict it to "Q8:Q" & LastRowOfChart?


 
Upvote 0
How do you define the last row of chart?
 
Upvote 0
I used this code: CalculatorLastRow = ThisWorkbook.Sheets(1).Cells.Cells.SpecialCells(xlCellTypeLastCell).row - 11

The contents under the chart does not change and I calculated that if I used the above code, the land row of the chart is always 11 rows above the above last cell with special attributes.
 
Upvote 0
Ok, how about
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim LastRow As Long
   If Target.CountLarge > 1 Then Exit Sub
   LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row - 11
   If Not Intersect(Target, Range("Q8:Q" & LastRow)) Is Nothing Then
      Me.Unprotect
      Application.EnableEvents = False
      Target.Value = IIf(Target.Value = "", "P", "")
      Application.EnableEvents = True
      Me.Protect
   ElseIf Target.Address(0, 0) = "L5" Then
      Me.Unprotect
      Application.EnableEvents = False
      Select Case Target.Value
         Case "Store Pick-up":      Target.Value = "HQ Shipping"
         Case "HQ Shipping":        Target.Value = "Store Shipping"
         Case "Store Shipping":     Target.Value = "Supplier Drop Ship"
         Case "Supplier Drop Ship": Target.Value = "Store Pick-up"
      End Select
      Me.Protect
      Application.EnableEvents = True
   End If
End Sub
 
Upvote 0
That code change made my Excel freeze. It seems to be and endless loop. I had to forcibly close Excel and restart. Any advice?
 
Upvote 0
It's the specialcells that's causing the problem, Try
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim LastRow As Long
   If Target.CountLarge > 1 Then Exit Sub
   LastRow = Cells.Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row - 11
   If Not Intersect(Target, Range("Q8:Q" & LastRow)) Is Nothing Then
      Me.Unprotect
      Application.EnableEvents = False
      Target.Value = IIf(Target.Value = "", "P", "")
      Application.EnableEvents = True
      Me.Protect
   ElseIf Target.Address(0, 0) = "L5" Then
      Me.Unprotect
      Application.EnableEvents = False
      Select Case Target.Value
         Case "Store Pick-up":      Target.Value = "HQ Shipping"
         Case "HQ Shipping":        Target.Value = "Store Shipping"
         Case "Store Shipping":     Target.Value = "Supplier Drop Ship"
         Case "Supplier Drop Ship": Target.Value = "Store Pick-up"
      End Select
      Me.Protect
      Application.EnableEvents = True
   End If
End Sub
 
Upvote 0
Solution
That worked although I had to change -11 to -5 to get the accurate last row of the Chart. Thanks.
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,243
Members
448,555
Latest member
RobertJones1986

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