Delete Multiple Sheets

[marcenet03]

0
I have the following code to delete multiple sheets. This code takes forever to delete the sheets, not sure how can I speed up the process. If someone can help me out, would be great.

Sub DeleteSelectedSheets()

Dim h As Long, RESA1() As Variant

RESA1 = Array("Upload EC", "V-UploadEC", "EC Proj Data", "Orion SA Proj Data", _
"Orion SA Data Table", "Proj Data", "Tables our", "Qty", "Multi Sites", "Data table" _
, "Tbls", "Match", "Cov", "Quote", "Agg Quote", "RFQ", "Contractor", "HEER", "HEER_L", _
"Site Decl", "Post Decl", "$", "$Enl", "ESInfo", "NBB Training", "T&C", "Work Order", "Installer Contract", "Recycle", "Rent", "PM", _
"Xero", "Xero prep", "T&C Quote", "T&C VIC", "T&C noCert", "N-Nom", "CB PM Ledger", _
"N-A9s", "N-A10s", "V-A-Lamp-Ballast", "VEET LCP", "VEU_LCP_35", "V-B-Space", _
"V18 tbls", "V-C-BCA", "V-Compliance", "V-other", "ESS Other", "VIC pcode")

On Error Resume Next
Application.DisplayAlerts = False

For h = LBound(RESA1) To UBound(RESA1)
Worksheets(RESA1(h)).Delete
Next h



Application.DisplayAlerts = True
On Error GoTo 0

 

[DanteAmor]

If all the sheets exist then:

Sub Macro2()
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Sheets(Array("Upload EC", "V-UploadEC", "EC Proj Data", "Orion SA Proj Data", _
    "Orion SA Data Table", "Proj Data", "Tables our", "Qty", "Multi Sites", "Data table" _
    , "Tbls", "Match", "Cov", "Quote", "Agg Quote", "RFQ", "Contractor", "HEER", "HEER_L", _
    "Site Decl", "Post Decl", "$", "$Enl", "ESInfo", "NBB Training", "T&C", "Work Order", "Installer Contract", "Recycle", "Rent", "PM", _
    "Xero", "Xero prep", "T&C Quote", "T&C VIC", "T&C noCert", "N-Nom", "CB PM Ledger", _
    "N-A9s", "N-A10s", "V-A-Lamp-Ballast", "VEET LCP", "VEU_LCP_35", "V-B-Space", _
    "V18 tbls", "V-C-BCA", "V-Compliance", "V-other", "ESS Other", "VIC pcode")).Select
  ActiveWindow.SelectedSheets.Delete
End Sub

 

[Trebor76]

Try this:

Option Explicit
Sub Macro1()

    Dim xlnCalcMethod As XlCalculation
    
    With Application
        .ScreenUpdating = False
        xlnCalcMethod = .Calculation
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With

    Sheets(Array("Upload EC", "V-UploadEC", "EC Proj Data", "Orion SA Proj Data", _
                 "Orion SA Data Table", "Proj Data", "Tables our", "Qty", "Multi Sites", "Data table", _
                 "Tbls", "Match", "Cov", "Quote", "Agg Quote", "RFQ", "Contractor", "HEER", "HEER_L", _
                 "Site Decl", "Post Decl", "$", "$Enl", "ESInfo", "NBB Training", "T&C", "Work Order", "Installer Contract", "Recycle", "Rent", "PM", _
                 "Xero", "Xero prep", "T&C Quote", "T&C VIC", "T&C noCert", "N-Nom", "CB PM Ledger", _
                 "N-A9s", "N-A10s", "V-A-Lamp-Ballast", "VEET LCP", "VEU_LCP_35", "V-B-Space", _
                 "V18 tbls", "V-C-BCA", "V-Compliance", "V-other", "ESS Other", "VIC pcode")).Delete
                  
    With Application
        .Calculation = xlnCalcMethod
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
End Sub

 

[marcenet03]

If all the sheets exist then:

Sub Macro2()
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Sheets(Array("Upload EC", "V-UploadEC", "EC Proj Data", "Orion SA Proj Data", _
    "Orion SA Data Table", "Proj Data", "Tables our", "Qty", "Multi Sites", "Data table" _
    , "Tbls", "Match", "Cov", "Quote", "Agg Quote", "RFQ", "Contractor", "HEER", "HEER_L", _
    "Site Decl", "Post Decl", "$", "$Enl", "ESInfo", "NBB Training", "T&C", "Work Order", "Installer Contract", "Recycle", "Rent", "PM", _
    "Xero", "Xero prep", "T&C Quote", "T&C VIC", "T&C noCert", "N-Nom", "CB PM Ledger", _
    "N-A9s", "N-A10s", "V-A-Lamp-Ballast", "VEET LCP", "VEU_LCP_35", "V-B-Space", _
    "V18 tbls", "V-C-BCA", "V-Compliance", "V-other", "ESS Other", "VIC pcode")).Select
  ActiveWindow.SelectedSheets.Delete
End Sub

I've already tried it and takes forever. To many sheets with tables and formulas

 

[DanteAmor]

Another option to check if the sheets exist.

Sub Macro1A()
  Dim shs() As Variant, i As Long, deleteSh() As Variant, n As Long
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False
  shs = Array("Upload EC", "V-UploadEC", "EC Proj Data", "Orion SA Proj Data", _
"Orion SA Data Table", "Proj Data", "Tables our", "Qty", "Multi Sites", "Data table" _
, "Tbls", "Match", "Cov", "Quote", "Agg Quote", "RFQ", "Contractor", "HEER", "HEER_L", _
"Site Decl", "Post Decl", "$", "$Enl", "ESInfo", "NBB Training", "T&C", "Work Order", "Installer Contract", "Recycle", "Rent", "PM", _
"Xero", "Xero prep", "T&C Quote", "T&C VIC", "T&C noCert", "N-Nom", "CB PM Ledger", _
"N-A9s", "N-A10s", "V-A-Lamp-Ballast", "VEET LCP", "VEU_LCP_35", "V-B-Space", _
"V18 tbls", "V-C-BCA", "V-Compliance", "V-other", "ESS Other", "VIC pcode")
  For i = 0 To UBound(shs)
    If Evaluate("ISREF('" & shs(i) & "'!A1)") Then
      ReDim Preserve deleteSh(n)
      deleteSh(n) = shs(i)
      n = n + 1
    End If
  Next
  Sheets(deleteSh).Select
  ActiveWindow.SelectedSheets.Delete
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
End Sub

 

[DanteAmor]

How many sheets does the book have, maybe it is more practical to copy the surviving sheets to a new book.

 

[marcenet03]

How many sheets does the book have, maybe it is more practical to copy the surviving sheets to a new book.

59. Is more complicated.As there are formula links, tables, etc. Thank you

 

[DanteAmor]

You are removing 50 sheets.
If any of those sheets have reference to any of the surviving sheets, the formulas will have the error #Ref.
So it would be simpler to copy 9 sheets to a new file, delete the old file. And if you want, the new file rename it with the name of the source file.
That process will take only a couple of seconds.

 

[Trebor76]

I've already tried it and takes forever. To many sheets with tables and formulas

Did you try my solution in thread 3?. I check and hold he current calculation method, set it to manual, delete the sheets and then set the calculation method back to its original setting.