[X]My Assistant

[aggiemarine07]

So i have a bit of complex code that does what I need it to (loop through all excel files within a folder, add a worksheet from a master file to the current workbook, and do a few other minor things). However, now on the final step, I want it to remove all worksheets not named "WFM PLOG" but cant figure out how to implement it. I have tried a few different methods including LEN >0 and such but it just isnt working (subscript out of range error). Any help would be greatly appreciated. Thanks!

CODE

Sub Command0_Click()
Dim xl As Excel.Application
Dim wbMaster As Excel.Workbook
Set xl = New Excel.Application
Set wbMaster = xl.Workbooks.Open(CurrentProject.path & "\ProjectBabelfish")

Dim wsCopy As Excel.Worksheet
Set wsCopy = wbMaster.Worksheets("Babelfish")

Dim sFolderPath As String
sFolderPath = wbMaster.path & "\PLOGs\"
If Right(sFolderPath, 1) <> "\" Then sFolderPath = sFolderPath & "\"

Dim sFileName As String
sFileName = Dir(sFolderPath & "*.xlsx")

Dim StrFile As String: StrFile = CurrentProject.path & "\PLOGs\*.xlsb"

'Disable screenupdating (to prevent "screen flickering" so macro runs smoother)
'Disable alerts (to suppress "Are you sure?" prompts during worksheet deletion)
xl.ScreenUpdating = False
xl.DisplayAlerts = False

On Error Resume Next
If Len(Dir$(StrFile)) > 0 Then
    SetAttr StrFile, vbNormal
    Kill StrFile
End If

'Begin loop through files in the folder
Do While Len(sFileName) > 0

    Dim sWBOpenPassword As String
    Dim sWBProtectPassword As String
    Select Case sFileName
        'Specify workbook names that require passwords here
        Case "book1.xlsx"
            sWBOpenPassword = "550"
            sWBProtectPassword = "550"

        'If different books require different passwords, can specify additional names with their unique passwords
        Case "Book3.xlsx"
            sWBOpenPassword = "book3openpassword"
            sWBProtectPassword = "book3protectionpassword"

        'Keep specifying excel file names and their passwords until completed
        Case "Book10.xlsx", "Book257.xlsx"
            sWBOpenPassword = "GenericOpenPW2"
            sWBProtectPassword = "GenericProtectPW2"

        'Case Else will handle the remaining workbooks that don't require passwords
        Case Else
            'MsgBox sFileName & " has a wierd password"
            sWBOpenPassword = "550"
            sWBProtectPassword = "550"

    End Select

    'Open file using password (if any)
    On Error Resume Next
    With xl.Workbooks.Open(sFolderPath & sFileName, UpdateLinks:=False, Password:=sWBOpenPassword)
        If Err.Number = 1004 Then MsgBox "The workbook " & sFileName & " is at a middle school dance."
        Dim bProtectedWB As Boolean
        bProtectedWB = False    'Reset protected wb check to false

        If .ProtectStructure = True Then bProtectedWB = True 'Check if workbook is protected and if so unprotect it using the specified protection password
        If bProtectedWB = True Then .Unprotect sWBProtectPassword
            
        .Sheets(1).Name = "Whole Foods Market PLOG"
        'MsgBox "Name of Sheets: " & .Sheets(1).Name & ", " & .Sheets(2).Name & ", " & .Sheets(3).Name
        If .Worksheets("Whole Foods Market PLOG").Range("A20") = "" Then
                .Sheets(1).Delete
                .Sheets(1).Name = "Whole Foods Market PLOG"
                End If
            
        On Error Resume Next    'Suppress error if copied worksheet does not yet exist
        .Worksheets(wsCopy.Name).Delete 'Delete existing sheet if it exists
        On Error GoTo 0         'Remove "On Error Resume Next" condition
    
            wsCopy.Copy after:=.Worksheets(.Worksheets.Count)   'Copy template into the workbook
            .Worksheets(wsCopy.Name).Cells.Replace wbMaster.Name, .Name 'Change references from master workbook to current workbook
                        
            .Worksheets("Babelfish").Activate
            .Worksheets("Babelfish").Range("A2:Y2").Select
            .Worksheets("Babelfish").Range("A2:Y2").Copy
            .Worksheets("Babelfish").Range("A2:Y2").PasteSpecial Paste:=xlPasteValues
            .Worksheets("Babelfish").Range("AA2:AE201").Select
            .Worksheets("Babelfish").Range("AA2:AE201").Copy
            .Worksheets("Babelfish").Range("AA2:AE201").PasteSpecial Paste:=xlPasteValues
            .Worksheets("Babelfish").Range("AH2:CK201").Select
            .Worksheets("Babelfish").Range("AH2:CK201").Copy
            .Worksheets("Babelfish").Range("AH2:CK201").PasteSpecial Paste:=xlPasteValues
            
            .Sheets(2).Name = "WFM PLOG"
            
'---> This is where I want to delete all excess worksheets
            If Len(.Sheets(9).Name) > 0 Then
                If .Sheets(9).Name <> "WFM PLOG" Then .Sheets(9).Delete
                Else: Resume Next
                End If
            If Len(.Sheets(8).Name) > 0 Then
                If .Sheets(8).Name <> "WFM PLOG" Then .Sheets(8).Delete
                Else: Resume Next
                End If
            If Len(.Sheets(7).Name) > 0 Then
                If .Sheets(7).Name <> "WFM PLOG" Then .Sheets(7).Delete
                Else: Resume Next
                End If
            If Len(.Sheets(6).Name) > 0 Then
                If .Sheets(6).Name <> "WFM PLOG" Then .Sheets(6).Delete
                Else: Resume Next
                End If
            If Len(.Sheets(5).Name) > 0 Then
                If .Sheets(5).Name <> "WFM PLOG" Then .Sheets(5).Delete
                Else: Resume Next
                End If
            If Len(.Sheets(4).Name) > 0 Then
                If .Sheets(4).Name <> "WFM PLOG" Then .Sheets(4).Delete
                Else: Resume Next
                End If
            If Len(.Sheets(3).Name) > 0 Then
                If .Sheets(3).Name <> "WFM PLOG" Then .Sheets(3).Delete
                Else: Resume Next
                End If
            If Len(.Sheets(2).Name) > 0 Then
                If .Sheets(2).Name <> "WFM PLOG" Then .Sheets(2).Delete
                Else: Resume Next
                End If
            If Len(.Sheets(1).Name) > 0 Then
                If .Sheets(1).Name <> "WFM PLOG" Then .Sheets(1).Delete
                Else: Resume Next
                End If
'--->End of where I want to delete all excess worksheets
                                                    
            If bProtectedWB = True Then .Protect sWBProtectPassword   'If workbook was protected, reprotect it with same protection password
        
        If Not IsEmpty(varLinks) Then
            For i = 1 To UBound(varLinks)
                .BreakLink _
                    Name:=varLinks(i), _
                    Type:=xlLinkTypeExcelLinks
            Next i
        End If
        
        .SaveAs FileName:=sFolderPath & Mid(sFileName, 1, Len(sFileName) - 5) & ".xlsb", FileFormat:=xlExcel12, CreateBackup:=False
        .Save
        .Close True

    End With
      
    sFileName = Dir 'Advance to next file in the folder
    
Loop

'Re-enable screenupdating and alerts
xl.ScreenUpdating = True
xl.DisplayAlerts = True
xl.Quit

MsgBox "Added Tab to all PLOG files"

End Sub

Private Sub Command1_Click()
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM BabelfishImport"
Call Import_Excel
Call DeleteImportErrors
MsgBox "Finished import all excel files"
DoCmd.SetWarnings True
End Sub

Private Sub Command4_Click()
Dim xl As Excel.Application
Set xl = New Excel.Application

xl.ScreenUpdating = False
xl.DisplayAlerts = False
Call LoopAllExcelFilesInFolder

End Sub

[DanielPineault]

What about a function along the lines of

CODE

Sub DeleteWorkSheets()
    Dim Sht                   As Excel.Worksheet

    Application.DisplayAlerts = False
    For Each Sht In ThisWorkbook.Worksheets
        Select Case Sht.Name
        Case Is <> "WFM PLOG"
            Sht.Delete
        End Select
    Next Sht
    Application.DisplayAlerts = True
End Sub

[arnelgp]

CODE

    Dim Sht  As Worksheet
    Application.DisplayAlerts = False
    For Each Sht In .Worksheets
        Select Case UCase(Sht.Name)
        Case "wfm_plog", "babelfish"
        Case Else
            Sht.Delete
        End Select
    Next Sht

This post has been edited by arnelgp: Sep 4 2019, 09:27 AM

[aggiemarine07]

@DanielPineault I tried that method as I found it elsewhere on the internet and I get a "run time error 1004; method 'thisworkbook' of object '_global' failed" within the function at

CODE

For Each Sht In ThisWorkbook.Worksheets

[DanielPineault]

If you use arnelgp's example, be sure to turn the DisplayAlerts back on by add the following line to the end of the procedure

CODE

Application.DisplayAlerts = True

[DanielPineault]

It depends on how you are implementing things, but try simply switching

CODE

For Each Sht In ThisWorkbook.Worksheets

to

CODE

For Each Sht In .Worksheets

You should truly define a workbook object variable then you could more easily work with the workbook and pass it to called procedures and the likes.

[aggiemarine07]

@arnelgp thanks for the response

I get an invalid procedure or argument (runtime error 5) at

CODE

sFileName = Dir 'Advance to next file in the folder

[aggiemarine07]

@DanielPineault thanks so much for your help! After making your recommended adjustment, now I get: Compile Error, invalid or unqualified reference at

CODE

For Each Sht In .Worksheets

[arnelgp]

you have 2 dir on the beginning of the sub.
first dir, for sFileName, 2nd strFile.
it will remember the last dir() you made.

to prevent this, add all sFileName to a collection object
and loop through this collection and not executing dir() again:

CODE

Dim colFiles as New Collection
Dim sFileName As String
Dim i As Integer
sFileName = Dir(sFolderPath & "*.xlsx")
While sFileName <> ""
   colFiles.Add sFolderPath & sFileName
   sFileName = Dir
Wend

replace this line:

CODE

Do While Len(sFileName) > 0

with:

CODE

For i = 1 to colFiles.Count
sFileName = colFiles(i)

remove the "Loop" at the end and replace with "Next"
remove also the "Dir" at the end of the loop.

edit:
you will need to replace this also:

CODE

   With xl.Workbooks.Open(sFolderPath & sFileName, UpdateLinks:=False, Password:=sWBOpenPassword)

with:

CODE

   With xl.Workbooks.Open(sFileName, UpdateLinks:=False, Password:=sWBOpenPassword)

sFilename already has the Path when we save it to collection object.
This post has been edited by arnelgp: Sep 4 2019, 10:19 AM

[DanielPineault]

Dir is only for very simple use cases. When you need to perform complex operations, loops within loops, ... then you should turn towards FSO instead as it doesn't suffer from the same issues.

[aggiemarine07]

@arnelgp thanks for the adjustments that I needed to make but now Access is freezing when I run the script do you think it has something to do with that @DanielPineault was talking about? Do I just need to re-write this with FSO? If so how would I go about doing that? Thanks.

[arnelgp]

here is the rework:

CODE

Sub Command0_Click()
Dim xl As Excel.Application
Dim wbMaster As Excel.Workbook
Set xl = New Excel.Application
Set wbMaster = xl.Workbooks.Open(CurrentProject.Path & "\ProjectBabelfish")

Dim wsCopy As Excel.Worksheet
Set wsCopy = wbMaster.Worksheets("Babelfish")

Dim sFolderPath As String
sFolderPath = wbMaster.Path & "\PLOGs\"
If Right(sFolderPath, 1) <> "\" Then sFolderPath = sFolderPath & "\"

Dim sFileName As String
'--start agp
Dim sh As Worksheet
Dim cFiles As New Collection
Dim i As Integer
sFileName = Dir(sFolderPath & "*.xlsx")
While sFileName <> ""
    cFiles.Add sFileName
    sFileName = Dir
Wend
'--end agp

Dim StrFile As String: StrFile = CurrentProject.Path & "\PLOGs\*.xlsb"

'Disable screenupdating (to prevent "screen flickering" so macro runs smoother)
'Disable alerts (to suppress "Are you sure?" prompts during worksheet deletion)
xl.ScreenUpdating = False
xl.DisplayAlerts = False

On Error Resume Next
If Len(Dir$(StrFile)) > 0 Then
    SetAttr StrFile, vbNormal
    Kill StrFile
End If

'Begin loop through files in the folder
'Do While Len(sFileName) > 0
For i = 1 To cFiles.count
    Dim sWBOpenPassword As String
    Dim sWBProtectPassword As String
    '--agp
    sFileName = cFiles(i)
    '--end agp
    Select Case sFileName
        'Specify workbook names that require passwords here
        Case "book1.xlsx"
            sWBOpenPassword = "550"
            sWBProtectPassword = "550"

        'If different books require different passwords, can specify additional names with their unique passwords
        Case "Book3.xlsx"
            sWBOpenPassword = "book3openpassword"
            sWBProtectPassword = "book3protectionpassword"

        'Keep specifying excel file names and their passwords until completed
        Case "Book10.xlsx", "Book257.xlsx"
            sWBOpenPassword = "GenericOpenPW2"
            sWBProtectPassword = "GenericProtectPW2"

        'Case Else will handle the remaining workbooks that don't require passwords
        Case Else
            'MsgBox sFileName & " has a wierd password"
            sWBOpenPassword = "550"
            sWBProtectPassword = "550"

    End Select

    'Open file using password (if any)
    On Error Resume Next
    With xl.Workbooks.Open(sFolderPath & sFileName, UpdateLinks:=False, Password:=sWBOpenPassword)
        If Err.Number = 1004 Then MsgBox "The workbook " & sFileName & " is at a middle school dance."
        Dim bProtectedWB As Boolean
        bProtectedWB = False    'Reset protected wb check to false

        If .ProtectStructure = True Then bProtectedWB = True 'Check if workbook is protected and if so unprotect it using the specified protection password
        If bProtectedWB = True Then .Unprotect sWBProtectPassword
            
        .Sheets(1).Name = "Whole Foods Market PLOG"
        'MsgBox "Name of Sheets: " & .Sheets(1).Name & ", " & .Sheets(2).Name & ", " & .Sheets(3).Name
        If .Worksheets("Whole Foods Market PLOG").Range("A20") = "" Then
                .Sheets(1).Delete
                .Sheets(1).Name = "Whole Foods Market PLOG"
        End If
            
        On Error Resume Next    'Suppress error if copied worksheet does not yet exist
        .Worksheets(wsCopy.Name).Delete 'Delete existing sheet if it exists
        On Error GoTo 0         'Remove "On Error Resume Next" condition
    
            wsCopy.Copy After:=.Worksheets(.Worksheets.count)   'Copy template into the workbook
            .Worksheets(wsCopy.Name).Cells.Replace wbMaster.Name, .Name 'Change references from master workbook to current workbook
                        
            .Worksheets("Babelfish").Activate
            .Worksheets("Babelfish").Range("A2:Y2").Select
            .Worksheets("Babelfish").Range("A2:Y2").Copy
            .Worksheets("Babelfish").Range("A2:Y2").PasteSpecial Paste:=xlPasteValues
            .Worksheets("Babelfish").Range("AA2:AE201").Select
            .Worksheets("Babelfish").Range("AA2:AE201").Copy
            .Worksheets("Babelfish").Range("AA2:AE201").PasteSpecial Paste:=xlPasteValues
            .Worksheets("Babelfish").Range("AH2:CK201").Select
            .Worksheets("Babelfish").Range("AH2:CK201").Copy
            .Worksheets("Babelfish").Range("AH2:CK201").PasteSpecial Paste:=xlPasteValues
            
            .Sheets(2).Name = "WFM PLOG"
            
'---> This is where I want to delete all excess worksheets
            '--agp start
            For Each sh In .Worksheets
                If LCase(sh.Name) = "wfm plog" Then
                    sh.Delete
                End If
            Next sh
            '--agp end
            
            'If Len(.Sheets(9).Name) > 0 Then
            ''    If .Sheets(9).Name <> "WFM PLOG" Then .Sheets(9).Delete
            '    Else: Resume Next
            '    End If
            'If Len(.Sheets(8).Name) > 0 Then
            '    If .Sheets(8).Name <> "WFM PLOG" Then .Sheets(8).Delete
            '    Else: Resume Next
            '    End If
            'If Len(.Sheets(7).Name) > 0 Then
            '    If .Sheets(7).Name <> "WFM PLOG" Then .Sheets(7).Delete
            '    Else: Resume Next
            '    End If
            'If Len(.Sheets(6).Name) > 0 Then
            '    If .Sheets(6).Name <> "WFM PLOG" Then .Sheets(6).Delete
            '    Else: Resume Next
            '    End If
            'If Len(.Sheets(5).Name) > 0 Then
            '    If .Sheets(5).Name <> "WFM PLOG" Then .Sheets(5).Delete
            '    Else: Resume Next
            '    End If
            'If Len(.Sheets(4).Name) > 0 Then
            ''    If .Sheets(4).Name <> "WFM PLOG" Then .Sheets(4).Delete
            '    Else: Resume Next
            '    End If
            'If Len(.Sheets(3).Name) > 0 Then
            '    If .Sheets(3).Name <> "WFM PLOG" Then .Sheets(3).Delete
            '    Else: Resume Next
            '    End If
            'If Len(.Sheets(2).Name) > 0 Then
            '    If .Sheets(2).Name <> "WFM PLOG" Then .Sheets(2).Delete
            '    Else: Resume Next
            '    End If
            'If Len(.Sheets(1).Name) > 0 Then
            '    If .Sheets(1).Name <> "WFM PLOG" Then .Sheets(1).Delete
            '    Else: Resume Next
            '    End If
'--->End of where I want to delete all excess worksheets
                                                    
            If bProtectedWB = True Then .Protect sWBProtectPassword   'If workbook was protected, reprotect it with same protection password
        '--agp start
                ' we are already using i variable for our outer loop
                Dim j As Integer
        If Not IsEmpty(varLinks) Then
            For j = 1 To UBound(varLinks)
                .BreakLink _
                    Name:=varLinks(i), _
                    Type:=xlLinkTypeExcelLinks
            Next j
        End If
        
        .SaveAs FileName:=sFolderPath & Mid(sFileName, 1, Len(sFileName) - 5) & ".xlsb", FileFormat:=xlExcel12, CreateBackup:=False
        .Save
        .Close True

    End With
    '--agp start
    'sFileName = Dir 'Advance to next file in the folder
    '--agp end
'Loop
Next i
'Re-enable screenupdating and alerts
xl.ScreenUpdating = True
xl.DisplayAlerts = True
xl.Quit
Set xl = Nothing
MsgBox "Added Tab to all PLOG files"

End Sub

This post has been edited by arnelgp: Sep 4 2019, 12:54 PM

[aggiemarine07]

@arnelgp wow! thanks for all that hard work! When I put copy/pasted that into Access, it runs successfully but doesnt delete the spreadsheets; any idea why?

edit: its also prompting me to if I want to save the master excel document; do i just need to move the xl.Quit line up?
This post has been edited by aggiemarine07: Sep 4 2019, 02:04 PM

[DanielPineault]

You should set a workbook variable, even sheet variables.

CODE

Set xlWrkBk = xl.Workbooks.Open(sFolderPath & sFileName, UpdateLinks:=False, Password:=sWBOpenPassword)

Then either code would work because you'd be driectly binding to the specified workbook

CODE

            For Each sh In xlWrkBk .Worksheets
                If LCase(sh.Name) = "wfm plog" Then
                    sh.Delete
                End If
            Next sh

I'm a little confused by

CODE

            .SaveAs FileName:=sFolderPath & Mid(sFileName, 1, Len(sFileName) - 5) & ".xlsb", FileFormat:=xlExcel12, CreateBackup:=False
            .Save
            .Close True

You're saving it as another file name, then saving it, then closing and saving it yet again?

also

CODE

Set wbMaster = xl.Workbooks.Open(CurrentProject.Path & "\ProjectBabelfish")

no extension specified?

You are specifying On Error Resume Next a couple times in the code, no need, just once. Even at that, you would be better with proper error handling, right now you are ignoring errors, so you might not be getting errors reported back to you explaining why the code isn't working as expected. On Error Resume Next is to be avoid as much as possible.

[aggiemarine07]

@DanielPineault Those last two questions you posted were just simple errors on my part, probably from staring at this code much these last few days

I made the suggested edits from the front half of your post but it still does not remove the worksheets not labeled "WFM PLOG". I feel like im missing something stupid/insignificant :-/

Here is the revised code:

CODE

Sub Command0_Click()
Dim xl As Excel.Application
Dim wbMaster As Excel.Workbook
Set xl = New Excel.Application
Set wbMaster = xl.Workbooks.Open(CurrentProject.path & "\ProjectBabelfish.xlsb")

Dim wsCopy As Excel.Worksheet
Set wsCopy = wbMaster.Worksheets("Babelfish")

Dim sFolderPath As String
sFolderPath = wbMaster.path & "\PLOGs\"
If Right(sFolderPath, 1) <> "\" Then sFolderPath = sFolderPath & "\"

Dim sFileName As String
'--start agp
Dim sh As Worksheet
Dim cFiles As New Collection
Dim i As Integer
sFileName = Dir(sFolderPath & "*.xlsx")
While sFileName <> ""
    cFiles.Add sFileName
    sFileName = Dir
Wend
'--end agp

Dim StrFile As String: StrFile = CurrentProject.path & "\PLOGs\*.xlsb"

'Disable screenupdating (to prevent "screen flickering" so macro runs smoother)
'Disable alerts (to suppress "Are you sure?" prompts during worksheet deletion)
xl.ScreenUpdating = False
xl.DisplayAlerts = False

On Error Resume Next
If Len(Dir$(StrFile)) > 0 Then
    SetAttr StrFile, vbNormal
    Kill StrFile
End If

'Begin loop through files in the folder
'Do While Len(sFileName) > 0
For i = 1 To cFiles.Count
    Dim sWBOpenPassword As String
    Dim sWBProtectPassword As String
    '--agp
    sFileName = cFiles(i)
    '--end agp
    Select Case sFileName
        'Specify workbook names that require passwords here
        Case "book1.xlsx"
            sWBOpenPassword = "550"
            sWBProtectPassword = "550"

        'If different books require different passwords, can specify additional names with their unique passwords
        Case "Book3.xlsx"
            sWBOpenPassword = "book3openpassword"
            sWBProtectPassword = "book3protectionpassword"

        'Keep specifying excel file names and their passwords until completed
        Case "Book10.xlsx", "Book257.xlsx"
            sWBOpenPassword = "GenericOpenPW2"
            sWBProtectPassword = "GenericProtectPW2"

        'Case Else will handle the remaining workbooks that don't require passwords
        Case Else
            'MsgBox sFileName & " has a wierd password"
            sWBOpenPassword = "550"
            sWBProtectPassword = "550"

    End Select

    'Open file using password (if any)
    On Error Resume Next
    With xl.Workbooks.Open(sFolderPath & sFileName, UpdateLinks:=False, Password:=sWBOpenPassword)
        If Err.Number = 1004 Then MsgBox "The workbook " & sFileName & " is at a middle school dance."
        Dim bProtectedWB As Boolean
        bProtectedWB = False    'Reset protected wb check to false

        If .ProtectStructure = True Then bProtectedWB = True 'Check if workbook is protected and if so unprotect it using the specified protection password
        If bProtectedWB = True Then .Unprotect sWBProtectPassword
            
        .Sheets(1).Name = "Whole Foods Market PLOG"
        'MsgBox "Name of Sheets: " & .Sheets(1).Name & ", " & .Sheets(2).Name & ", " & .Sheets(3).Name
        If .Worksheets("Whole Foods Market PLOG").Range("A20") = "" Then
                .Sheets(1).Delete
                .Sheets(1).Name = "Whole Foods Market PLOG"
        End If
            
        On Error Resume Next    'Suppress error if copied worksheet does not yet exist
        .Worksheets(wsCopy.Name).Delete 'Delete existing sheet if it exists
        On Error GoTo 0         'Remove "On Error Resume Next" condition
    
            wsCopy.Copy After:=.Worksheets(.Worksheets.Count)   'Copy template into the workbook
            .Worksheets(wsCopy.Name).Cells.Replace wbMaster.Name, .Name 'Change references from master workbook to current workbook
                        
            .Worksheets("Babelfish").Activate
            .Worksheets("Babelfish").Range("A2:Y2").Select
            .Worksheets("Babelfish").Range("A2:Y2").Copy
            .Worksheets("Babelfish").Range("A2:Y2").PasteSpecial Paste:=xlPasteValues
            .Worksheets("Babelfish").Range("AA2:AE201").Select
            .Worksheets("Babelfish").Range("AA2:AE201").Copy
            .Worksheets("Babelfish").Range("AA2:AE201").PasteSpecial Paste:=xlPasteValues
            .Worksheets("Babelfish").Range("AH2:CK201").Select
            .Worksheets("Babelfish").Range("AH2:CK201").Copy
            .Worksheets("Babelfish").Range("AH2:CK201").PasteSpecial Paste:=xlPasteValues
            
            .Sheets(2).Name = "WFM PLOG"
            
            Set xlWrkBk = xl.Workbooks.Open(sFolderPath & sFileName, UpdateLinks:=False, Password:=sWBOpenPassword)
            
            For Each sh In xlWrkBk.Worksheets
                If LCase(sh.Name) = "wfm plog" Then
                    sh.Delete
                End If
            Next sh
                                                                
            If bProtectedWB = True Then .Protect sWBProtectPassword   'If workbook was protected, reprotect it with same protection password
        '--agp start
                ' we are already using i variable for our outer loop
                Dim j As Integer
        If Not IsEmpty(varLinks) Then
            For j = 1 To UBound(varLinks)
                .BreakLink _
                    Name:=varLinks(i), _
                    Type:=xlLinkTypeExcelLinks
            Next j
        End If
        
        .SaveAs FileName:=sFolderPath & Mid(sFileName, 1, Len(sFileName) - 5) & ".xlsb", FileFormat:=xlExcel12, CreateBackup:=False
        .Close True

    End With
Next i
'Re-enable screenupdating and alerts
xl.ScreenUpdating = True
xl.DisplayAlerts = True
xl.Quit
Set xl = Nothing
MsgBox "Added Tab to all PLOG files"

End Sub

[MadPiet]

Not sure what you're doing wrong. (Are you saving the files after making the changes?)

This worked to delete the sheets that don't start with the prefix "wfm plog"

CODE

    Dim sht As Worksheet
    For Each sht In ActiveWorkbook.Sheets
        If Left$(sht.Name, 8) <> "wfm plog" Then
            sht.Delete
        End If
    Next sht

But if you don't save the workbook after doing this, you're not saving the changes.

[arnelgp]

CODE

Sub Command0_Click()
Dim xl As Excel.Application
Dim wbMaster As Excel.Workbook
Dim xlWrkBk As Excel.Workbook

Set xl = New Excel.Application
Set wbMaster = xl.Workbooks.Open(CurrentProject.Path & "\ProjectBabelfish.xlsb")

Dim wsCopy As Excel.Worksheet
Set wsCopy = wbMaster.Worksheets("Babelfish")

Dim sFolderPath As String
sFolderPath = wbMaster.Path & "\PLOGs\"
If Right(sFolderPath, 1) <> "\" Then sFolderPath = sFolderPath & "\"

Dim sFileName As String
'--start agp
Dim sh As Worksheet
Dim cFiles As New Collection
Dim i As Integer
sFileName = Dir(sFolderPath & "*.xlsx")
While sFileName <> ""
    cFiles.Add sFileName
    sFileName = Dir
Wend
'--end agp

Dim StrFile As String: StrFile = CurrentProject.Path & "\PLOGs\*.xlsb"

'Disable screenupdating (to prevent "screen flickering" so macro runs smoother)
'Disable alerts (to suppress "Are you sure?" prompts during worksheet deletion)
xl.ScreenUpdating = False
xl.DisplayAlerts = False

On Error Resume Next
If Len(Dir$(StrFile)) > 0 Then
    SetAttr StrFile, vbNormal
    Kill StrFile
End If

'Begin loop through files in the folder
'Do While Len(sFileName) > 0
For i = 1 To cFiles.Count
    Dim sWBOpenPassword As String
    Dim sWBProtectPassword As String
    '--agp
    sFileName = cFiles(i)
    '--end agp
    Select Case sFileName
        'Specify workbook names that require passwords here
        Case "book1.xlsx"
            sWBOpenPassword = "550"
            sWBProtectPassword = "550"
        
        'If different books require different passwords, can specify additional names with their unique passwords
        Case "Book3.xlsx"
            sWBOpenPassword = "book3openpassword"
            sWBProtectPassword = "book3protectionpassword"
        
        'Keep specifying excel file names and their passwords until completed
        Case "Book10.xlsx", "Book257.xlsx"
            sWBOpenPassword = "GenericOpenPW2"
            sWBProtectPassword = "GenericProtectPW2"
        
        'Case Else will handle the remaining workbooks that don't require passwords
        Case Else
            'MsgBox sFileName & " has a wierd password"
            sWBOpenPassword = "550"
            sWBProtectPassword = "550"
        
    End Select
    
    'Open file using password (if any)
    On Error Resume Next
    Set xlWrkBk = xl.Workbooks.Open(sFolderPath & sFileName, UpdateLinks:=False, Password:=sWBOpenPassword)
    If Err.Number = 1004 Then
        MsgBox "The workbook " & sFileName & " is at a middle school dance."
    Else
        With xlWrkBk
            Dim bProtectedWB As Boolean
            bProtectedWB = False    'Reset protected wb check to false
            
            If .ProtectStructure = True Then bProtectedWB = True 'Check if workbook is protected and if so unprotect it using the specified protection password
            If bProtectedWB = True Then .Unprotect sWBProtectPassword
            
            .Sheets(1).Name = "Whole Foods Market PLOG"
            'MsgBox "Name of Sheets: " & .Sheets(1).Name & ", " & .Sheets(2).Name & ", " & .Sheets(3).Name
            If .Worksheets("Whole Foods Market PLOG").Range("A20") = "" Then
                .Sheets(1).Delete
                .Sheets(1).Name = "Whole Foods Market PLOG"
            End If
            
            On Error Resume Next    'Suppress error if copied worksheet does not yet exist
            .Worksheets(wsCopy.Name).Delete 'Delete existing sheet if it exists
            On Error GoTo 0         'Remove "On Error Resume Next" condition
            
            wsCopy.Copy After:=.Worksheets(.Worksheets.Count)   'Copy template into the workbook
            .Worksheets(wsCopy.Name).Cells.Replace wbMaster.Name, .Name 'Change references from master workbook to current workbook
            
            .Worksheets("Babelfish").Activate
            .Worksheets("Babelfish").Range("A2:Y2").Select
            .Worksheets("Babelfish").Range("A2:Y2").Copy
            .Worksheets("Babelfish").Range("A2:Y2").PasteSpecial Paste:=xlPasteValues
            .Worksheets("Babelfish").Range("AA2:AE201").Select
            .Worksheets("Babelfish").Range("AA2:AE201").Copy
            .Worksheets("Babelfish").Range("AA2:AE201").PasteSpecial Paste:=xlPasteValues
            .Worksheets("Babelfish").Range("AH2:CK201").Select
            .Worksheets("Babelfish").Range("AH2:CK201").Copy
            .Worksheets("Babelfish").Range("AH2:CK201").PasteSpecial Paste:=xlPasteValues
            
            .Sheets(2).Name = "WFM PLOG"
            
            Dim j As Integer
            For j = .Worksheets.Count To 1 Step -1
                If Trim(LCase(.Worksheets(j).Name)) = "wfm plog" Then
                    .Worksheets(j).Delete
                End If
            Next j
                                
            If bProtectedWB = True Then .Protect sWBProtectPassword   'If workbook was protected, reprotect it with same protection password
            '--agp start
            ' we are already using i variable for our outer loop
            If Not IsEmpty(varLinks) Then
                For j = 1 To UBound(varLinks)
                    .BreakLink _
                    Name:=varLinks(i), _
                    Type:=xlLinkTypeExcelLinks
                    Next j
            End If
            
            .SaveAs Filename:=sFolderPath & Mid(sFileName, 1, Len(sFileName) - 5) & ".xlsb", FileFormat:=xlExcel12, CreateBackup:=False
            .Close True
                
        End With
    End If
Next i
'Re-enable screenupdating and alerts
xl.ScreenUpdating = True
xl.DisplayAlerts = True
xl.Quit
Set xl = Nothing
MsgBox "Added Tab to all PLOG files"
    
End Sub

[aggiemarine07]

@arnelgp and @MadPiet I was able to resolve it by combing stuff from both of your posts. I changed the Object at the top from:

CODE

Dim sh As Worksheet

To

CODE

Dim sht As Worksheet

And I also changed this:

CODE

Dim j As Integer
For j = .Worksheets.Count To 1 Step -1
   If Trim(LCase(.Worksheets(j).Name)) = "wfm plog" Then
      .Worksheets(j).Delete
End If
Next j

To this:

CODE

Dim j As Integer
xl.ScreenUpdating = False
xl.DisplayAlerts = False
For j = .Worksheets.Count To 1 Step -1
   If .Worksheets(j).Name <> "WFM PLOG" Then
   .Worksheets(j).Delete
   .SaveAs FileName:=sFolderPath & Mid(sFileName, 1, Len(sFileName) - 5) & ".xlsb", FileFormat:=xlExcel12, CreateBackup:=False
End If
Next j

And now it does exactly as I originally intended, thank you so much for all of your help and expertise!