I have built an Excel tool for a client with dynamic dropdowns. It uses a lot of dynamic arrays. In the Worksheet Change event I have some code which hides and unhides the rows that are not in use (so as to show only the array results), and clears the dependent dropdowns when the main ones are changed.
The file is not very large, 207kb.
In early versions the client could use the file. However as we have moved through the versions he has experienced gradually increasing issues with it hanging and not showing the data, to the point that the file is not working at all for him any more. I cannot replicate this problem, I've tried it on my husband's desktop and on his laptop as well as my own computer.
The client has been saving the file in a trusted location to enable the macros. The client's sales manager experienced the same issues so it isn't just him. I got him to send it back to me in case it was something to do with the email delivery or it being a file from the internet, but the re-sent version works fine for me too.
What could it possibly be? The client is very busy and not very tech savvy so I am having a hard time pinning down more details about the problem.
The version of the file that still sort of works for him is clearly problematic. He says "I was able to get it to work and avoid crashes by saving the version I was working on when I finished in a separate safe folder and then reopening it out of that safe folder and repeating the process. I have multiple folders, but it works."
I cannot think what could be causing this.
Here is my code, in case it's because I'm doing something dumb in Worksheet Change.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Errorhandler1
Dim wb As Workbook
Set wb = ThisWorkbook
If Not wb Is ActiveWorkbook Then
Exit Sub
End If
If ActiveSheet.Name <> "Template" Then
Exit Sub
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim CheckCell As Range
'clears the relevant bits of the template if the cart base model is changed
'clears whichever margin cell is not in use
If Not Intersect(Target, Range("Margin_1")) Is Nothing Then
Range("margin_2").ClearContents
ElseIf Not Intersect(Target, Range("margin_2")) Is Nothing Then
Range("Margin_1").ClearContents
End If
' checks if any of base model, lifted / non lifted or cart model or street legal have been changed
If Not Intersect(Target, Range("ChangeCell_2")) Is Nothing Or _
Not Intersect(Target, Range("ChangeCell_3")) Is Nothing Or _
Not Intersect(Target, Range("ChangeCell_4")) Is Nothing Or _
Not Intersect(Target, Range("ChangeCell_5")) Is Nothing Or _
Not Intersect(Target, Range("ChangeCell_6")) Is Nothing Or _
Not Intersect(Target, Range("ChangeCell_7")) Is Nothing Then
On Error Resume Next
If Not Intersect(Target, Range("ChangeCell_2")) Is Nothing Then
'if cart base model is changed
Range("ChangeCell_3").ClearContents 'clears lifted / non lifted
Range("ChangeCell_4").ClearContents 'clears number of passengers
Range("ChangeCell_5").ClearContents 'clears battery type
Range("ChangeCell_6").ClearContents 'clears engine type
Range("ChangeCell_7").ClearContents 'clears motor/ street legal
Range("ChangeCell_8").ClearContents 'clears standard / extended range
Application.ScreenUpdating = True
Range("Base_Car_Header").Activate
Application.ScreenUpdating = False
ElseIf Not Intersect(Target, Range("ChangeCell_4")) Is Nothing Then
'if number of passengers is changed
Range("ChangeCell_6").ClearContents 'clears engine type
Range("ChangeCell_7").ClearContents 'clears motor/ street legal
Range("ChangeCell_8").ClearContents 'clears standard vs extended range
ElseIf Not Intersect(Target, Range("ChangeCell_5")) Is Nothing Then
'if battery type is changed
Range("ChangeCell_8").ClearContents 'clears standard vs extended range
ElseIf Not Intersect(Target, Range("ChangeCell_6")) Is Nothing Then
'if engine type is changed
Range("ChangeCell_7").ClearContents 'clears motor/ street legal
End If
'if cart is 4 person lithium ion, enter default range as standard
If Range("changecell_4") = 4 And Range("changecell_5") = Worksheets("Dropdowns").Range("LithiumIon") Then
Range("changecell_8") = Worksheets("Dropdowns").Range("Default_Range")
End If
'clears all the appropriate ranges when inputs are changed
Dim i As Integer
For i = 1 To 20
On Error Resume Next
Range("Clear_" & i).ClearContents
Next
Range("Assemblies_QTY").ClearContents
Range("Assemblies_UnitCost").ClearContents
Range("Assemblies_Notes").ClearContents
Range("Assemblies_Adjustments").ClearContents
'Hides the rows that are not needed for this cart
Dim Rw As Range
For i = 1 To 6
On Error Resume Next
For Each Rw In Range("Hide_Rows_" & i)
If IsEmpty(Rw) Then
If Rw.EntireRow.Hidden = False Then
Rw.EntireRow.Hidden = True
End If
Else
Rw.EntireRow.Hidden = False
Rw.EntireRow.AutoFit
End If
Next
Next
End If
' if the active cell is in the cosmetics choices then just do the cosmetics section
If Not Application.Intersect(Target, Range("Clear_1")) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
For Each Rw In Range("Cosmetics_Headers")
If IsEmpty(Rw) Then
If Rw.EntireRow.Hidden = False Then
Rw.EntireRow.Hidden = True
End If
Else
Rw.EntireRow.Hidden = False
Rw.EntireRow.AutoFit
End If
Next
End If
' if the active cell is in the accessories choices then just do the accessories summary section
If Not Application.Intersect(Target, Range("Accessories_Changes")) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
For Each Rw In Range("Accessories_Headers")
If IsEmpty(Rw) Then
If Rw.EntireRow.Hidden = False Then
Rw.EntireRow.Hidden = True
End If
Else
Rw.EntireRow.Hidden = False
Rw.EntireRow.AutoFit
End If
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
'if the active cell is in the assemblies choices then just do the assemblies section
If Not Application.Intersect(Target, Range("Clear_2")) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
For Each Rw In Range("Assemblies_Detail")
If IsEmpty(Rw) Then
If Rw.EntireRow.Hidden = False Then
Rw.EntireRow.Hidden = True
End If
Else
Rw.EntireRow.Hidden = False
Rw.EntireRow.AutoFit
End If
Next
For Each Rw In Range("Assemblies_Headers")
If IsEmpty(Rw) Then
If Rw.EntireRow.Hidden = False Then
Rw.EntireRow.Hidden = True
End If
Else
Rw.EntireRow.Hidden = False
Rw.EntireRow.AutoFit
End If
Next
'clear out qty and adjs if assemblies options are chosen
Range("Assemblies_QTY").ClearContents
Range("Assemblies_UnitCost").ClearContents
Range("Assemblies_Notes").ClearContents
Range("Assemblies_Adjustments").ClearContents
End If
' if the active cell is in the accessories choices then just do the accessories summary section
If Not Application.Intersect(ActiveCell, Range("Clear_7")) Is Nothing Or _
Not Application.Intersect(ActiveCell, Range("Clear_13")) Is Nothing Then
Application.EnableEvents = False
On Error Resume Next
For Each Rw In Range("Accessories_Headers")
If IsEmpty(Rw) Then
If Rw.EntireRow.Hidden = False Then
Rw.EntireRow.Hidden = True
End If
Else
Rw.EntireRow.Hidden = False
Rw.EntireRow.AutoFit
End If
Next
End If
'clears qty and unit cost data for assemblies if option 1 is changed
If Not Intersect(Target, Range("Assemblies_Input_1")) Is Nothing Then
Range("Assemblies_QTY").ClearContents
Range("Assemblies_UnitCost").ClearContents
Range("Assemblies_Notes").ClearContents
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
Errorhandler1:
MsgBox ("Something has gone wrong with the Worksheet Change macro. Please contact the developer.")
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
(Based on your shared file)
Not really tested much, but should give you some ideas:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook, errMsg As String
Dim CheckCell As Range, i As Long, rw As Range
On Error GoTo Errorhandler
errMsg = "something went wrong with the change event macro."
Set wb = ThisWorkbook
If Not wb Is ActiveWorkbook Then Exit Sub
If ActiveSheet.Name <> Me.Name Then Exit Sub '### are you sure you want to do this?
Application.ScreenUpdating = False
Application.EnableEvents = False
'clears the relevant bits of the template if the cart base model is changed
'no need for multiple error handlers if only the message changes...
errMsg = "Something has gone wrong with the Margin Clearing macro."
'clears whichever margin cell is not in use
If InAnyNamedRange(Target, "Margin_1") Then
ClearAll "margin_2"
ElseIf InAnyNamedRange(Target, "margin_2") Then
ClearAll "Margin_1"
End If
errMsg = "Something has gone wrong with the macro for clearing of the main boxes."
' checks if any of base model, lifted / non lifted or cart model or street legal have been changed
If InAnyNamedRange(Target, "ChangeCell_2", "ChangeCell_3", "ChangeCell_4", _
"ChangeCell_5", "ChangeCell_6", "ChangeCell_7") Then
If InAnyNamedRange(Target, "ChangeCell_2") Then 'if cart base model is changed
'clears lifted / non lifted,number of passengers,battery type,engine type,motor/ street legal,standard / extended range
ClearAll "ChangeCell_3", "ChangeCell_4", "ChangeCell_5", _
"ChangeCell_6", "ChangeCell_7", "ChangeCell_8"
Application.ScreenUpdating = True
Range("Base_Car_Header").Activate '### see note below about using ActiveCell
Application.ScreenUpdating = False
'ElseIf Not Intersect(Target, Range("ChangeCell_3")) Is Nothing Then 'if lifted / non lifted is changed
'Range("ChangeCell_4").ClearContents 'clears number of passengers
'Range("ChangeCell_5").ClearContents 'clears battery type
'Range("ChangeCell_6").ClearContents 'clears engine type
'Range("ChangeCell_7").ClearContents 'clears motor/ street legal
ElseIf InAnyNamedRange(Target, "ChangeCell_4") Then 'if number of passengers is changed
'Range("ChangeCell_5").ClearContents 'clears battery type
ClearAll "ChangeCell_6", "ChangeCell_7", "ChangeCell_8" 'engine type,motor/ street legal,standard vs extended range
ElseIf InAnyNamedRange(Target, "ChangeCell_5") Then 'if battery type is changed
ClearAll "ChangeCell_8" 'clears standard vs extended range
'Range("ChangeCell_6").ClearContents 'clears engine type
' Range("ChangeCell_7").ClearContents 'clears motor/ street legal
ElseIf InAnyNamedRange(Target, "ChangeCell_6") Then 'if engine type is changed
ClearAll "ChangeCell_7" ' motor/ street legal
End If
'if cart is 4 person lithium ion, enter default range as standard
With ThisWorkbook.Worksheets("Dropdowns")
If Range("changecell_4").Value = 4 And Range("changecell_5").Value = .Range("LithiumIon").Value Then
Range("changecell_8").Value = .Range("Default_Range").Value
End If
End With
errMsg = "Something has gone wrong with the macro for looping through the ranges to clear on the template body."
For i = 1 To 20
'Application.ScreenUpdating = True
'[u4] = i
'[u5] = Range("Clear_" & i).Address
'Application.ScreenUpdating = False
'MsgBox Range("Clear_" & i).Address
ClearAll "Clear_" & i 'clears all the appropriate ranges when inputs are changed
Next
ClearAll "Assemblies_QTY", "Assemblies_UnitCost", "Assemblies_Notes", "Assemblies_Adjustments"
errMsg = "Something has gone wrong with the macro for hiding and unhiding the rows."
'Hides the rows that are not needed for this cart
For i = 1 To 6
ShowHideRows Range("Hide_Rows_" & i)
Next
End If 'in any of the list of named ranges
If InAnyNamedRange(Target, "Clear_1") Then
ShowHideRows Range("Cosmetics_Headers")
End If
'MsgBox Range("accessories_changes").Address
'MsgBox ActiveCell.Address
If InAnyNamedRange(Target, "Accessories_Changes") Then
ShowHideRows Range("Accessories_Headers")
End If
'if the active cell is in the assemblies choices then just do the assemblies section
If InAnyNamedRange(Target, "Clear_2") Then
ShowHideRows Range("Assemblies_Detail")
ShowHideRows Range("Assemblies_Headers")
'clear out qty and adjs if assemblies options are chosen
ClearAll "Assemblies_QTY", "Assemblies_UnitCost", "Assemblies_Notes", "Assemblies_Adjustments"
End If
' if the active cell is in the accessories choices then just do the accessories summary section
'### Not sure why you're using ActiveCell here?
'### You should use a range variable instead
If InAnyNamedRange(ActiveCell, "Clear_7", "Clear_13") Then
ShowHideRows Range("Accessories_Headers")
End If
'clears qty and unit cost data for assemblies if option 1 is changed
If InAnyNamedRange(Target, "Assemblies_Input_1") Then
ClearAll "Assemblies_QTY", "Assemblies_UnitCost", "Assemblies_Notes"
End If
done:
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
Errorhandler:
MsgBox errMsg & "Please contact the developer.", vbExclamation
Resume done
End Sub
'Return True if Target is in any range with a Name in the list passed to `rangeNames`
Function InAnyNamedRange(targ As Range, ParamArray rangeNames() As Variant) As Boolean
Dim nm
For Each nm In rangeNames
If Not Application.Intersect(targ, Range(nm)) Is Nothing Then
InAnyNamedRange = True
Exit Function
End If
Next nm
End Function
'clear contents from all ranges with names in the list passed to `rangeNames`
Sub ClearAll(ParamArray rangeNames() As Variant)
Dim nm
For Each nm In rangeNames
Range(nm).ClearContents
Next nm
End Sub
'hide any empty rows in range `rng`
Sub ShowHideRows(rng As Range)
Dim rw As Range, c As Range, rngHide As Range
'unhide all rows...
With rng.EntireRow
.Hidden = False
.AutoFit
End With
'...then hide any empty cells
For Each c In rng
If Len(c.Value) = 0 Then
If rngHide Is Nothing Then
Set rngHide = c
Else
Set rngHide = Application.Union(rngHide, c)
End If
End If
Next c
'any rows to hide?
If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True
End Sub