Cell change by selection Error

pingme89

Board Regular
Joined
Jan 23, 2014
Messages
125
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:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
34,030
Office Version
365
Platform
Windows
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
 

pingme89

Board Regular
Joined
Jan 23, 2014
Messages
125
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.
 

pingme89

Board Regular
Joined
Jan 23, 2014
Messages
125
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?


 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
34,030
Office Version
365
Platform
Windows
How do you define the last row of chart?
 

pingme89

Board Regular
Joined
Jan 23, 2014
Messages
125
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.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
34,030
Office Version
365
Platform
Windows
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
 

pingme89

Board Regular
Joined
Jan 23, 2014
Messages
125
That code change made my Excel freeze. It seems to be and endless loop. I had to forcibly close Excel and restart. Any advice?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
34,030
Office Version
365
Platform
Windows
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
 

pingme89

Board Regular
Joined
Jan 23, 2014
Messages
125
That worked although I had to change -11 to -5 to get the accurate last row of the Chart. Thanks.
 

Forum statistics

Threads
1,086,237
Messages
5,388,637
Members
402,127
Latest member
Jemx

Some videos you may like

This Week's Hot Topics

Top