Issue With VBA Code Stopped Working

RegularExcelUser

New Member
Joined
Apr 6, 2023
Messages
25
Office Version
  1. 365
Platform
  1. Windows
I had used this piece of code I'd found on Youtube to allow me build a drop-down list where the user could select several options in a drop down list as opposed to just one. I had applied this to several different cells in my worksheet and it worked fine. However, it has now stopped working and I can't figure out why. I did originally have the Target.Address set as specific cell R1C1 references, but decided to name the cells as I have other script running on the same page that inserts rows based on clicking a command button, and another that hides rows based on selecting certain dropdown options. I thought it might be something to do with some of the other code, so I deleted those out entirely in a copy of my file to see if that would work. Unfortunately, that hasn't done the trick either. Appreciate it if someone could take a look and suggest why it might not be working, other changes I could make that might make it work or even a whole new code if you think there's a better way to do it.

VBA Code:
Private Sub Worksheet_Change3(ByVal Target As Range)
'Code by Sumit Bansal from https://trumpexcel.com
' To allow multiple selections in a Drop Down List in Excel (without repetition)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = "Badges" Or Target.Address = "Placeholder_Badges" Or Target.Address = "Delivery_Days" Or Target.Address = "Select_By_Country" Or Target.Address = "Select_By_Region" Then
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
  Else: If Target.Value = "" Then GoTo Exitsub Else
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
      If Oldvalue = "" Then
        Target.Value = Newvalue
      Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & vbNewLine & Newvalue
      Else:
        Target.Value = Oldvalue
      End If
    End If
  End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
 
If you put a break point near the top, then make a change on the sheet that should "trigger" the code to run, it should enter into the code and then stop at the breakpoint.
At that point, you should be able to use the F8 key to loop through the code.
 
Upvote 0

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
In that case it needs to be like
VBA Code:
If Target.Address = Range("Badges").address Or Target.Address = Range("Placeholder_Badges").Address ...
Yeah, I thought that was odd. They said in the original post:
I had applied this to several different cells in my worksheet and it worked fine.
Not sure how they were able to get it to work fine like that, and thought maybe I was missing something, and just trusted what they told me.
 
Upvote 0
In that case it needs to be like
VBA Code:
If Target.Address = Range("Badges").address Or Target.Address = Range("Placeholder_Badges").Address ...
Thanks Fluff, that kind of got me there, but I'm still having problems. It all falls apart when I introduce a Worksheet_SelectionChange into the module as well. Is there a reason for this e.g. it's not like I have 2 Worksheet_Change in? I can share the code if needs be.
 
Upvote 0
It just depend on what the selection change code does. If it's changing the value of any of those cells, then you would need to disable events.
 
Upvote 0
Hmm, truthfully not sure. 2 of the rows in the Worksheet Change code are hidden by the Worksheet Selection Change code if a particular value is selected in a preceeding cell, might try taking those 2 out of the Worksheet Selection Change code and see what happens.
 
Upvote 0
Decided I would post the code to see if anybody can spot anything. The Worksheet Change code is designed to allow the selection of multiple options from drop down lists in the 5 named cells, and works fine as a standalone piece of code. However, when I add in the second piece of code which is a Worksheet Selection Change Code, and is designed to hide rows if a specific answer is selected in a preceeding named cell, the Worksheet Change ceases working and just Worksheet Selection Change code works. There are no common named cells between the Worksheet Change and the Worksheet Selection Change code, but 2 of the named cells in the Worksheet Change code could be hidden by the Worksheet Selection Change depending on the option chosen in a preceeding cell. Is there something obvious I'm missing here, or some alternate code I could try?

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Code by Sumit Bansal from https://trumpexcel.com
' To allow multiple selections in a Drop Down List in Excel (without repetition)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = Range("Badges").Address Or Target.Address = Range("Placeholder_Badges").Address Or Target.Address = Range("Delivery_Days").Address Or Target.Address = Range("Select_By_Country").Address Or Target.Address = Range("Select_By_Region").Address Then
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
  Else: If Target.Value = "" Then GoTo Exitsub Else
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
      If Oldvalue = "" Then
        Target.Value = Newvalue
      Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & vbNewLine & Newvalue
      Else:
        Target.Value = Oldvalue
      End If
    End If
  End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Range("Placeholder_Value").Value = "Do Not Tick" Then
Range("Placeholder_Value").Offset(1).Resize(1).EntireRow.Hidden = True
Else
Range("Placeholder_Value").Offset(1).Resize(1).EntireRow.Hidden = False
End If

If Range("Price_To_Display_Value").Value = "Do Not Tick" Then
Range("Price_To_Display_Value").Offset(1).Resize(1).EntireRow.Hidden = True
Else
Range("Price_To_Display_Value").Offset(1).Resize(1).EntireRow.Hidden = False
End If

If Range("Price_To_Display_Frequency_Value").Value = "Do Not Tick" Then
Range("Price_To_Display_Frequency_Value").Offset(1).Resize(1).EntireRow.Hidden = True
Else
Range("Price_To_Display_Frequency_Value").Offset(1).Resize(1).EntireRow.Hidden = False
End If

If Range("Payment_Providers_Value").Value = "Do not use" Then
Range("Payment_Providers_Value").Offset(1).Resize(1).EntireRow.Hidden = True
Else
Range("Payment_Providers_Value").Offset(1).Resize(1).EntireRow.Hidden = False
End If

If Range("Payment_Providers_Moto_Value").Value = "Do not use" Then
Range("Payment_Providers_Moto_Value").Offset(1).Resize(1).EntireRow.Hidden = True
Else
Range("Payment_Providers_Moto_Value").Offset(1).Resize(1).EntireRow.Hidden = False
End If

If Range("Cancellable_By_User_Value").Value = "Do Not Tick" Then
Range("Cancellable_By_User_Value").Offset(1).Resize(2).EntireRow.Hidden = True
Else
Range("Cancellable_By_User_Value").Offset(1).Resize(2).EntireRow.Hidden = False
End If

If Range("Delivery_Days_Value").Value = "Do Not Tick" Then
Range("Delivery_Days_Value").Offset(1).Resize(13).EntireRow.Hidden = True
Else
Range("Delivery_Days_Value").Offset(1).Resize(13).EntireRow.Hidden = False
End If

If Range("Original_Amount_Value").Value = "Do Not Tick" Then
Range("Original_Amount_Value").Offset(1).Resize(2).EntireRow.Hidden = True
Else
Range("Original_Amount_Value").Offset(1).Resize(2).EntireRow.Hidden = False
End If

If Range("Linked_To_Value").Value = "Do Not Tick" Then
Range("Linked_To_Value").Offset(1).Resize(1).EntireRow.Hidden = True
Else
Range("Linked_To_Value").Offset(1).Resize(1).EntireRow.Hidden = False
End If

If Range("Sales_TaxVAT_Rate_Value").Value = "Do not use" Then
Range("Sales_TaxVAT_Rate_Value").Offset(1).Resize(1).EntireRow.Hidden = True
Else
Range("Sales_TaxVAT_Rate_Value").Offset(1).Resize(1).EntireRow.Hidden = False
End If

If Range("Subscription_Payments_Value").Value = "Do Not Tick" Then
Range("Subscription_Payments_Value").Offset(1).Resize(1).EntireRow.Hidden = True
Else
Range("Subscription_Payments_Value").Offset(1).Resize(1).EntireRow.Hidden = False
End If

If Range("Set_Purchase_Duration_Value").Value = "Do Not Tick" Then
Range("Set_Purchase_Duration_Value").Offset(1).Resize(2).EntireRow.Hidden = True
Else
Range("Set_Purchase_Duration_Value").Offset(1).Resize(2).EntireRow.Hidden = False
End If

If Range("Start_At_Value").Value = "Do Not Tick" Then
Range("Start_At_Value").Offset(1).Resize(1).EntireRow.Hidden = True
Else
Range("Start_At_Value").Offset(1).Resize(1).EntireRow.Hidden = False
End If

If Range("Finish_At_Value").Value = "Do Not Tick" Then
Range("Finish_At_Value").Offset(1).Resize(1).EntireRow.Hidden = True
Else
Range("Finish_At_Value").Offset(1).Resize(1).EntireRow.Hidden = False
End If

If Range("Renewable_Value").Value = "Do Not Tick" Then
Range("Renewable_Value").Offset(1).Resize(2).EntireRow.Hidden = True
Else
Range("Renewable_Value").Offset(1).Resize(2).EntireRow.Hidden = False
End If

If Range("Renewable_Value").Value = "Do Not Tick" Then
Range("Renewable_Value").Offset(4).Resize(3).EntireRow.Hidden = True
Else
Range("Renewable_Value").Offset(4).Resize(3).EntireRow.Hidden = False
End If

If Range("Contract_Value").Value = "Do Not Tick" Then
Range("Contract_Value").Offset(1).Resize(20).EntireRow.Hidden = True
Else
Range("Contract_Value").Offset(1).Resize(20).EntireRow.Hidden = False
End If

If Range("Metered_Paywall_Value").Value = "Do not use" Then
Range("Metered_Paywall_Value").Offset(1).Resize(12).EntireRow.Hidden = True
Else
Range("Metered_Paywall_Value").Offset(1).Resize(12).EntireRow.Hidden = False
End If

If Range("Group_Accounts_Value").Value = "Do Not Tick" Then
Range("Group_Accounts_Value").Offset(1).Resize(1).EntireRow.Hidden = True
Else
Range("Group_Accounts_Value").Offset(1).Resize(1).EntireRow.Hidden = False
End If

If Range("Consumables_Value").Value = "Do Not Tick" Then
Range("Consumables_Value").Offset(1).Resize(5).EntireRow.Hidden = True
Else
Range("Consumables_Value").Offset(1).Resize(5).EntireRow.Hidden = False
End If

If Range("Custom_Text_Fields_Value").Value = "Do Not Tick" Then
Range("Custom_Text_Fields_Value").Offset(1).Resize(4).EntireRow.Hidden = True
Else
Range("Custom_Text_Fields_Value").Offset(1).Resize(4).EntireRow.Hidden = False
End If

If Range("Create_New_Coupon_Code").Value = "Do not use/Create in seperate template" Then
Range("Create_New_Coupon_Code").Offset(1).Resize(19).EntireRow.Hidden = True
Else
Range("Create_New_Coupon_Code").Offset(1).Resize(19).EntireRow.Hidden = False
End If

End Sub
 
Upvote 0

Forum statistics

Threads
1,224,534
Messages
6,179,391
Members
452,909
Latest member
VickiS

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