excel - How do I diagnose this file performance issue which I can't replicate? - Stack Overflow

admin管理员组

文章数量:1415697

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

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

• excel
• vba

Share Improve this question Follow edited Feb 4 at 20:37 VBasic2008 55.4k55 gold badges2020 silver badges3636 bronze badges asked Feb 4 at 19:01 HannahWHannahW 9877 bronze badges 12

• 1 It's pretty much impossible to guess what the issue could be, without seeing the actual code you're using. – Tim Williams Commented Feb 4 at 19:16
• 4 The best approach to that would be to comment out all the OERN and look at what specific errors you see. Then try to add some checks for those situations, so you can avoid raising any errors, instead of just ignoring them. At the very least, you need to reset your On Error GoTo Errorhandler1 after any need to an OERN has passed. Also a lot of repeated code in your sub which should ideally be factored out into separate reusable methods: less code typically means fewer bugs. Outside of that, it's impossible to test this without the workbook it lives in. – Tim Williams Commented Feb 4 at 19:48
• 1 Why have so many Application.EnableEvents = False lines. Normally disable events on entry and enable on exit. I haven't studied all the logic but I noticed an Application.EnableEvents = True in the accessories summary section and later 3 .ClearContents lines without any preceding disable event. – CDP1802 Commented Feb 4 at 20:09
• 1 You could share a link to the workbook, if it has no confidential/sensitive info, and you've removed any other code not related to the problem. Most folk here will not download a file, but anyone who does should be reviewing all the code before allowing macros to run, so excess code is a big pain... – Tim Williams Commented Feb 4 at 21:23
• 1 Have you checked what add-ins the client has installed? There's a possibility that one of those add-ins is also trapping Excel events, causing interference. This is a very common cause of "cannot reproduce client problem". I suggest you ask your client to disable all other add-ins and then re-test your workbook to see whether the problem goes away. – Neil T Commented Feb 4 at 21:32

 |  Show 7 more comments

1 Answer 1

Sorted by: Reset to default 2

(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

本文标签： excelHow do I diagnose this file performance issue which I can39t replicateStack Overflow