VBA Code Created In Excel 2016 Running Slowly

[VBNewbiwe83]

Hi Guys,

I m new to VBA ode and created a tool where I have code linked to a active x control button that clears certain cells in my xslm workbook.

The problem I am having is the tool is running slowly once the button is clicked.

Private Sub CommandButton13_Click()
    If MsgBox("Do you want to clear tool ready for a new call?", vbYesNo + vbQuestion, "***WARNING***") = vbYes Then
    ActiveSheet.Unprotect "Experience"
    Range("C18").ClearContents
    Range("C20").ClearContents
    Range("C24").ClearContents
    Range("C26:C27").ClearContents
    Range("C33").ClearContents
    Range("C35").ClearContents
    Range("C37").ClearContents
    Range("C43").ClearContents
    Range("C45").ClearContents
    Range("C46").ClearContents
    Range("C48").ClearContents
    Range("C54").ClearContents
    Range("C56:C57").ClearContents
    Range("C59").ClearContents
    Range("C61").ClearContents
    Range("C63").ClearContents
    Range("C69").ClearContents
    Range("C75:C76").ClearContents
    Range("C78:C80").ClearContents
    Range("C82:C83").ClearContents
    Range("C87:C89").ClearContents
    Range("C92").ClearContents
    Range("C12").Select
    Selection.Copy
    ActiveSheet.Protect "Experience", True, True
        End If
End Sub

I also use another code to autofit row based on vlookup responses so not sure which one may be causing the problem:

Private Sub Worksheet_Calculate()
    ActiveSheet.Unprotect "Experience"
    Range("A19").Rows.AutoFit
    Range("A21").Rows.AutoFit
    Range("A25").Rows.AutoFit
    Range("A28").Rows.AutoFit
    Range("A34").Rows.AutoFit
    Range("A36").Rows.AutoFit
    Range("A38").Rows.AutoFit
    Range("A44").Rows.AutoFit
    Range("A47").Rows.AutoFit
    Range("A49").Rows.AutoFit
    Range("A55").Rows.AutoFit
    Range("A58").Rows.AutoFit
    Range("A60").Rows.AutoFit
    Range("A62").Rows.AutoFit
    Range("A64").Rows.AutoFit
    Range("A70").Rows.AutoFit
    Range("A77").Rows.AutoFit
    Range("A81").Rows.AutoFit
    Range("A84").Rows.AutoFit
    Range("A92").Rows.AutoFit
    ActiveSheet.Protect "Experience", True, True
End Sub

Thanks for any help

 

[gallen]

Hello, if code is running slow, then you may have code in worksheet_change event or workbook_change event.

If you disable code while you do it it should help. Also you can cut the code down as below: I've included error handling as is essential when disabling events.

Private Sub CommandButton13_Click()
    Dim sAddress As String
    
    On Error GoTo errHandle
    


    
    If MsgBox("Do you want to clear tool ready for a new call?", vbYesNo + vbQuestion, "***WARNING***") = vbYes Then
        ActiveSheet.Unprotect "Experience"
        
        
        sAddress = "C18,C20,C24,C26:C27,C33,C35,C37,C43,C45:c46,C48,C54,C56:C57,C59,C61,C63,C69,C75:C76,C78:C80," & _
        "C82:C83,C87:C89,C92"
        
        'diasable change events
        Application.EnableEvents = False
        
        Range(sAddress).ClearContents
        
        're-enable events
        Application.EnableEvents = True
        
        Range("C12").Select
        Selection.Copy
        
        ActiveSheet.Protect "Experience", True, True
    End If


Exit Sub
errHandle:
    'if there is an error ensure to re-enable events
    MsgBox Err.Description
    Application.EnableEvents = True
End Sub

Please note that I've only reduced the code for the first example you gave. Same can be applied to 2nd example.

 

[VBNewbiwe83]

Wow ... this has sorted it.

I will try to do the same with second question.

Thanks s much for or help

 

[VBNewbiwe83]

Hi,

Sorry to be a pain but I am getting this error "Method 'range' of object'_worksheet Failed. What am I doing wrong?

Private Sub Worksheet_Calculate()
Dim sAddress As String
On Error GoTo errHandle
    
    ActiveSheet.Unprotect "Experience"
    sAddress = "A19, A21, A25, A28, A34, A36, A38, A44, A47, A49, A55, A58, A60, A62, A64, A70, A77, A81, A84, A92,"
'disable change events
Application.EnableEvents = False
Range(sAddress).Rows.AutoFit
're-enable events
Application.EnableEvents = True
    ActiveSheet.Protect "Experience", True, True
errHandle:
'if there is an error ensure to re-enable events
MsgBox Err.Description
Application.EnableEvents = True
End Sub
[code/]

Thanks

 

[Fluff]

Try

Range(sAddress).EntireRow.AutoFit

 

[VBNewbiwe83]

Thanks for your reply, I now get "object doesn't support this property or method"

Private Sub Worksheet_Calculate()
 Dim sAddress As String
 On Error GoTo errHandle
 ActiveSheet.Unprotect "Experience"
 sAddress = "A19, A21, A25, A28, A34, A36, A38, A44, A47, A49, A55, A58, A60, A62, A64, A70, A77, A81, A84, A92"
 'disable change events
 Application.EnableEvents = False
 Range(sAddress).EntireRows.AutoFit
 're-enable events
 Application.EnableEvents = True
 ActiveSheet.Protect "Experience", True, True
errHandle:
 'if there is an error ensure to re-enable events
 MsgBox Err.Description
 Application.EnableEvents = True
 End Sub

appreciate any help

 

[Fluff]

You've put an s on the end of EntireRow, remove it

 

[VBNewbiwe83]

Ha ha, thanks for all your help

 

[Fluff]

Glad we could help & thanks for the feedback