Delete Worksheet (if it exist) and Delete Top 4 Rows on remaining worksheets

[JohanGduToit]

Greetings Experts,

Please assist me with an Error 91 generated in the following code on the 1st occurrence of line "For Each Sheet in ActiveWorkbook.Worksheets"

I am attempting to loop through all worksheets to see if a worksheet titled "Updated Allocation List" exist, and if it does, to delete it. I then want to delete the top 4 rows on all remaining worksheets. (I have commented out the deletion of the 4 top rows in the code below, because I also encounter an error when attempting to do run that code).

Once the abovementioned issue has been resolved I will need to add additional coding to remove all rows containing an array of text strings; but I will post a seperate thread on that issue

Please be so kind as to advise?

Many Thanks!

Public Sub FormatMarkham01(sFile As String)

'Delete Worksheet <Updated Allocation List> if sheet exist, Delete Rows 1 to 4 and Delete all Rows containing specified text

'On Error GoTo Err_FormatMarkham01
    
    Dim xlApp As Object
    Dim xlSheet As Object
        
    Application.SetOption "Show Status Bar", True
    vStatusBar = SysCmd(acSysCmdSetStatus, "Formatting Markham Sales File (Stage 1)... Please wait.")

    Set xlApp = CreateObject("Excel.Application")
    Set xlSheet = xlApp.Workbooks.Open(sFile).Sheets(1)

    With xlApp
       [B] For Each Sheet In ActiveWorkbook.Worksheets[/B]
            If Sheet.Name = "Updated Allocation List" Then
                .Application.DisplayAlerts = False
                .Application.Worksheets("Updated Allocation List").Delete
                .Application.DisplayAlerts = True
            End If
        Next Sheet
                
       [B] 'For Each Sheet In ActiveWorkbook.Worksheets
        '    .Application.Range("1:4").EntireRow.Delete
        'Next Sheet[/B]
                           
        .Application.Sheets(1).Select
        .Application.Range("A1").Select
        .Application.ActiveWorkbook.Save
        .Application.ActiveWorkbook.Close
        .Quit
   End With
   
   vStatusBar = SysCmd(acSysCmdClearStatus)

   Set xlSheet = Nothing
   Set xlApp = Nothing

    
'Exit_FormatMarkham01:
'    Exit Sub
    
'Err_FormatMarkham01:
'    vStatusBar = SysCmd(acSysCmdClearStatus)
'    MsgBox Err.Number & " - " & Err.Description
'    Set xlSheet = Nothing
'    Set xlApp = Nothing
'    Resume Exit_FormatMarkham01
    
End Sub

 

[BSALV]

     Dim sh    As Worksheet     'in the declarations

     On Error Resume Next     'ignore made errors
     Set sh = xlsheet.parent.Sheets("Updated Allocation List")     'this sheet
     On Error GoTo 0     'stop ignoring errors
     If Not sh Is Nothing Then     'does sheet exist ? Yes !
          Application.DisplayAlerts = False
          sh.Delete
          Application.DisplayAlerts = True
     End If

 

[BSALV]

i made a lot of lines comment and the macro without parameter, it's just to give you an idea ...

Sub FormatMarkham01()     '(sFile As String)

     'Delete Worksheet <Updated Allocation List> if sheet exist, Delete Rows 1 to 4 and Delete all Rows containing specified text

     'On Error GoTo Err_FormatMarkham01

     Dim xlApp As Object, WB, sh As Worksheet
     'Dim xlSheet As Object

     'Application.SetOption "Show Status Bar", True
     'vStatusBar = SysCmd(acSysCmdSetStatus, "Formatting Markham Sales File (Stage 1)... Please wait.")

     'Set xlApp = CreateObject("Excel.Application")
     'Set WB = xlApp.Workbooks.Open(sFile)'ignored in this test
     Set WB = ThisWorkbook     'just for test

     With WB
          On Error Resume Next     'ignore made errors
          Set sh = .Sheets("Updated Allocation List")     'this sheet
          On Error GoTo 0     'stop ignoring errors
          If Not sh Is Nothing Then     'does sheet exist ? Yes !
               Application.DisplayAlerts = False
               sh.Delete
               Application.DisplayAlerts = True
          End If

          For Each sh In .Worksheets
               sh.Range("1:4").Delete
          Next

          Application.Goto .Sheets(1).Range("A1")
          .Close 1
     '.Quit
     End With

     'vStatusBar = SysCmd(acSysCmdClearStatus)

     Set xlSheet = Nothing
     Set xlApp = Nothing

End Sub

 

[My Aswer Is This]

Try this:

Sub Delete_Sheet_And_Rows()
'Modified  4/20/2022  5:17:58 AM  EDT
Application.ScreenUpdating = False
Dim i As Long
Application.DisplayAlerts = False

For i = Sheets.Count To 1 Step -1

    If Sheets(i).Name = "Updated Allocation List" Then
        Sheets(i).Delete
    Else
        Sheets(i).Rows(1).Resize(4).Delete
    End If
Next
Application.ScreenUpdating = True
End Sub

 

[JohanGduToit]

Hi BSALV

Your code works great; thank you so much! Now I need assistance to delete the top 4 rows on all remaining worksheets... would you be so kind as to add the deletion of top 4 rows to your code? I'm not sure of the syntax and where to add it.

On another note : My amended original code below works perfectly every 1st time I run it; but as soon as I call the procedure a 2nd time it fails... any idea's as to why it's failing on the "For Each Sheet In ActiveWorkbook.Worksheets" line?

Your assistance much appreciated!

Set xlApp = CreateObject("Excel.Application")
    Set xlSheet = xlApp.Workbooks.Open(sFile).Sheets(1)

    With xlApp
       For Each Sheet In ActiveWorkbook.Worksheets
           If Sheet.Name = "Updated Allocation List" Then
               .Application.DisplayAlerts = False
               .Application.Worksheets("Updated Allocation List").Delete
               .Application.DisplayAlerts = True
               Else
                   .Application.Sheets(Sheet.Name).Select
                   .Application.Rows("1:4").Select
                   .Application.Selection.Delete shift:=xlUp
           End If
       Next Sheet
                
        .Application.Sheets(1).Select
        .Application.Range("A1").Select
        .Application.ActiveWorkbook.Save
        .Application.ActiveWorkbook.Close
        .Quit
   End With
   
   vStatusBar = SysCmd(acSysCmdClearStatus)

   Set xlSheet = Nothing
   Set xlApp = Nothing

 

[BSALV]

see #3
also comparing names is case sensitive, so
* or you set "Option Compare text" as 1st line of that module to make "only that" module case insensitive
* use

 If StrComp(Sheet.Name, "Updated Allocation List", vbTextCompare) = 0 Then

 

[JohanGduToit]

Hi "My Answer Is",

Thank you for suggestion...

It however fails with Error 438 "Object doesn't support this property or method" on line "Sheets(i).Resize(4).Delete"

 

[BSALV]

i was occupied by something else and the 10-minutes period expired ...
see #3
also comparing names is case sensitive, so
* or you set "Option Compare text" as 1st line of that module to make "only that" module case insensitive
* use

 If StrComp(Sheet.Name, "Updated Allocation List", vbTextCompare) = 0 Then

why it doesn't work the 2nd time ? No idea ...
But using sheet here as the name of a variable is rather dangerous, because sheet can very near to some terms VBA uses, so you'd better use MySheet or sh instead.

 For Each Sheet In ActiveWorkbook.Worksheets

Because you used worksheets, you don't have problems with charts, do you use protection ?

 

[My Aswer Is This]

Hi "My Answer Is",

Thank you for suggestion...

It however fails with Error 438 "Object doesn't support this property or method" on line "Sheets(i).Resize(4).Delete"

The script works fine for me.

 

[JohanGduToit]

Hi 'My Answer Is'

Your code works like a charm... I made a typo by omitting ".Rows(1)" from the "Sheets(i).Rows(1).Resize(4).Delete" line which caused Error 438. I had to add ".Application" to some lines to get the code to work...not sure why though. But hey, it works!!

Working Code below... thank you very much for your help!

Public Sub FormatMarkham01(sFile As String)

'Delete Worksheet <Updated Allocation List> if sheet exist, Delete Rows 1 to 4 and Delete all Rows containing specified text

'On Error GoTo Err_FormatMarkham01
    
    Dim xlApp As Object
    Dim xlSheet As Object
        
    Dim I As Long
        
    Application.SetOption "Show Status Bar", True
    vStatusBar = SysCmd(acSysCmdSetStatus, "Formatting Markham Sales File (Stage 1)... Please wait.")

    Set xlApp = CreateObject("Excel.Application")
    Set xlSheet = xlApp.Workbooks.Open(sFile).Sheets(1)

    With xlApp
        .Application.ScreenUpdating = False
        .Application.DisplayAlerts = False
        For I = .Application.Sheets.Count To 1 Step -1
            If .Application.Sheets(I).Name = "Updated Allocation List" Then
                .Application.Sheets(I).Delete
                Else
                    .Application.Sheets(I).Rows(1).Resize(4).Delete
            End If
        Next
        .Application.ScreenUpdating = True
                      
        .Application.Sheets(1).Select
        .Application.Range("A1").Select
        .Application.ActiveWorkbook.Save
        .Application.ActiveWorkbook.Close
        .Quit
   End With
   
   MsgBox "DONE!"
   vStatusBar = SysCmd(acSysCmdClearStatus)

   Set xlSheet = Nothing
   Set xlApp = Nothing

    
'Exit_FormatMarkham01:
'    Exit Sub
    
'Err_FormatMarkham01:
'    vStatusBar = SysCmd(acSysCmdClearStatus)
'    MsgBox Err.Number & " - " & Err.Description
'    Set xlSheet = Nothing
'    Set xlApp = Nothing
'    Resume Exit_FormatMarkham01
    
End Sub