VBA Loop to remove specific named worksheets within a folder

R

RyanHawkeye

New Member
Joined
Apr 9, 2015
Messages
26
Hello, I'm needing some help from you experts out there. I have a folder with multiple xlsx spreadsheets within it. I would truly love to have VBA Loop code rummage through all the folder's xlsx spreadsheets and keep worksheets named AR20, AR21, VT77, and GG65 and delete all the other worksheets. Any help will be appreciated. Thanks
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Sort by date Sort by votes
Try this :

VBA Code: 
Sub KeepSpecificSheets()
    Dim FolderPath As String
    Dim Filename As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim MasterWorkbook As Workbook
    Dim KeepSheets As Object
    Dim wsName As String
    
    ' Set the folder path
    FolderPath = "C:\Your\Folder\Path\" ' Change this to your folder path
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
    
    ' Store the master workbook
    Set MasterWorkbook = ThisWorkbook
    
    ' Define sheets to keep in a dictionary
    Set KeepSheets = CreateObject("Scripting.Dictionary")
    KeepSheets.Add "AR20", True
    KeepSheets.Add "AR21", True
    KeepSheets.Add "VT77", True
    KeepSheets.Add "GG65", True
    
    ' Loop through all xlsx files in the folder
    Filename = Dir(FolderPath & "*.xlsx")
    Do While Filename <> ""
        ' Open the workbook if it is not the master workbook
        If StrComp(FolderPath & Filename, MasterWorkbook.FullName, vbTextCompare) <> 0 Then
            Set wb = Workbooks.Open(FolderPath & Filename)
            
            ' Loop through all worksheets in the workbook
            Application.DisplayAlerts = False ' Suppress alerts for deleting sheets
            For Each ws In wb.Worksheets
                wsName = ws.Name
                If Not KeepSheets.exists(wsName) Then
                    ws.Delete
                End If
            Next ws
            Application.DisplayAlerts = True
            
            ' Save and close the workbook
            wb.Close SaveChanges:=True
        End If
        
        ' Get the next file
        Filename = Dir
    Loop
    
    MsgBox "Process Completed!", vbInformation
End Sub
 
Upvote 0
Logit said:
Try this :

VBA Code: 
Sub KeepSpecificSheets()
    Dim FolderPath As String
    Dim Filename As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim MasterWorkbook As Workbook
    Dim KeepSheets As Object
    Dim wsName As String
   
    ' Set the folder path
    FolderPath = "C:\Your\Folder\Path\" ' Change this to your folder path
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
   
    ' Store the master workbook
    Set MasterWorkbook = ThisWorkbook
   
    ' Define sheets to keep in a dictionary
    Set KeepSheets = CreateObject("Scripting.Dictionary")
    KeepSheets.Add "AR20", True
    KeepSheets.Add "AR21", True
    KeepSheets.Add "VT77", True
    KeepSheets.Add "GG65", True
   
    ' Loop through all xlsx files in the folder
    Filename = Dir(FolderPath & "*.xlsx")
    Do While Filename <> ""
        ' Open the workbook if it is not the master workbook
        If StrComp(FolderPath & Filename, MasterWorkbook.FullName, vbTextCompare) <> 0 Then
            Set wb = Workbooks.Open(FolderPath & Filename)
           
            ' Loop through all worksheets in the workbook
            Application.DisplayAlerts = False ' Suppress alerts for deleting sheets
            For Each ws In wb.Worksheets
                wsName = ws.Name
                If Not KeepSheets.exists(wsName) Then
                    ws.Delete
                End If
            Next ws
            Application.DisplayAlerts = True
           
            ' Save and close the workbook
            wb.Close SaveChanges:=True
        End If
       
        ' Get the next file
        Filename = Dir
    Loop
   
    MsgBox "Process Completed!", vbInformation
End Sub
Click to expand...
Thank you for your time and assitance. I get an error about workbook must contain at least one visible worksheet.
1734734796890.png
 
Upvote 0
Don't hide any sheets in the various workbooks where sheets will be deleted.
 
Upvote 0
Try this :

VBA Code: 
Sub KeepSpecificSheets()
    Dim FolderPath As String
    Dim Filename As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim MasterWorkbook As Workbook
    Dim KeepSheets As Object
    Dim wsName As String
    
    ' Set the folder path
    FolderPath = "C:\Your\Folder\Path\" ' Change this to your folder path
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
    
    ' Store the master workbook
    Set MasterWorkbook = ThisWorkbook
    
    ' Define sheets to keep in a dictionary
    Set KeepSheets = CreateObject("Scripting.Dictionary")
    KeepSheets.Add "AR20", True
    KeepSheets.Add "AR21", True
    KeepSheets.Add "VT77", True
    KeepSheets.Add "GG65", True
    
    ' Loop through all xlsx files in the folder
    Filename = Dir(FolderPath & "*.xlsx")
    Do While Filename <> ""
        ' Open the workbook if it is not the master workbook
        If StrComp(FolderPath & Filename, MasterWorkbook.FullName, vbTextCompare) <> 0 Then
            Set wb = Workbooks.Open(FolderPath & Filename)
            
            ' Loop through all worksheets in the workbook
            Application.DisplayAlerts = False ' Suppress alerts for deleting sheets
            For Each ws In wb.Worksheets
                wsName = ws.Name
                If Not KeepSheets.exists(wsName) Then
                    ws.Delete
                End If

                If sheet.Visible = xlSheetVeryHidden or sheet.Visible = xlSheetHidden Then
                     sheet.visible = xlSheetVisible
                     sheet.Delete
                End If

            Next ws
            Application.DisplayAlerts = True
            
            ' Save and close the workbook
            wb.Close SaveChanges:=True
        End If
        
        ' Get the next file
        Filename = Dir
    Loop
    
    MsgBox "Process Completed!", vbInformation
End Sub
 
Upvote 0
Logit said:
Try this :

VBA Code: 
Sub KeepSpecificSheets()
    Dim FolderPath As String
    Dim Filename As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim MasterWorkbook As Workbook
    Dim KeepSheets As Object
    Dim wsName As String
   
    ' Set the folder path
    FolderPath = "C:\Your\Folder\Path\" ' Change this to your folder path
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
   
    ' Store the master workbook
    Set MasterWorkbook = ThisWorkbook
   
    ' Define sheets to keep in a dictionary
    Set KeepSheets = CreateObject("Scripting.Dictionary")
    KeepSheets.Add "AR20", True
    KeepSheets.Add "AR21", True
    KeepSheets.Add "VT77", True
    KeepSheets.Add "GG65", True
   
    ' Loop through all xlsx files in the folder
    Filename = Dir(FolderPath & "*.xlsx")
    Do While Filename <> ""
        ' Open the workbook if it is not the master workbook
        If StrComp(FolderPath & Filename, MasterWorkbook.FullName, vbTextCompare) <> 0 Then
            Set wb = Workbooks.Open(FolderPath & Filename)
           
            ' Loop through all worksheets in the workbook
            Application.DisplayAlerts = False ' Suppress alerts for deleting sheets
            For Each ws In wb.Worksheets
                wsName = ws.Name
                If Not KeepSheets.exists(wsName) Then
                    ws.Delete
                End If

                If sheet.Visible = xlSheetVeryHidden or sheet.Visible = xlSheetHidden Then
                     sheet.visible = xlSheetVisible
                     sheet.Delete
                End If

            Next ws
            Application.DisplayAlerts = True
           
            ' Save and close the workbook
            wb.Close SaveChanges:=True
        End If
       
        ' Get the next file
        Filename = Dir
    Loop
   
    MsgBox "Process Completed!", vbInformation
End Sub
Click to expand...
This code gave the same error....but I'm 99% sure what is causing it. If the Spreadsheet doesnt have one of the worksheets I need it is ultimately deleting all the worksheets which cant be done because the Spreadsheet needs at least 1 worksheet. Are you able to add a part that deletes the spreadsheet entirely if it doesnt have any of the needed worksheets? I really do appreciate your help with this and it is a weekend so dont worry about this right now. Thanks so much!!! :)
 
Upvote 0
try
Code: 
Sub test()
    Dim myDir$, fn$, e, myList, ws As Worksheet, flg As Boolean
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1) & "\"
    End With
    If myDir = "" Then Exit Sub
    myList = Array("AR20", "AR21", "VT77", "GG65")
    fn = Dir(myDir & "*.xls*")
    Do While fn <> ""
        If myDir & fn <> ThisWorkbook.FullName Then
            With Workbooks.Open(myDir & fn)
                For Each e In myList
                    flg = Evaluate("isref('" & e & "'!a1)")
                    If flg Then Exit For
                Next
                If flg Then
                    For Each ws In .Worksheets
                        If IsNumeric(Application.Match(ws.Name, myList, 0)) Then
                            ws.Visible = -1
                        Else
                            Application.DisplayAlerts = False
                            ws.Delete
                            Application.DisplayAlerts = True
                        End If
                    Next
                End If
                .Close True
            End With
        End If
        fn = Dir
    Loop
End Sub
 
Upvote 0
Try this :

VBA Code: 
Sub KeepSpecificSheets()
    Dim FolderPath As String
    Dim Filename As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim MasterWorkbook As Workbook
    Dim KeepSheets As Object
    Dim wsName As String
    Dim FoundSheet As Boolean
    
    ' Set the folder path
    FolderPath = "C:\Your\Folder\Path\" ' Change this to your folder path
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
    
    ' Store the master workbook
    Set MasterWorkbook = ThisWorkbook
    
    ' Define sheets to keep in a dictionary
    Set KeepSheets = CreateObject("Scripting.Dictionary")
    KeepSheets.Add "AR20", True
    KeepSheets.Add "AR21", True
    KeepSheets.Add "VT77", True
    KeepSheets.Add "GG65", True
    
    ' Loop through all xlsx files in the folder
    Filename = Dir(FolderPath & "*.xlsx")
    Do While Filename <> ""
        ' Open the workbook if it is not the master workbook
        If StrComp(FolderPath & Filename, MasterWorkbook.FullName, vbTextCompare) <> 0 Then
            Set wb = Workbooks.Open(FolderPath & Filename)
            FoundSheet = False ' Initialize flag
            
            ' Check if any sheets to keep exist
            For Each ws In wb.Worksheets
                If KeepSheets.exists(ws.Name) Then
                    FoundSheet = True
                    Exit For
                End If
            Next ws
            
            ' If no sheets match the keep list, delete the workbook
            If Not FoundSheet Then
                Application.DisplayAlerts = False
                wb.Close SaveChanges:=False ' Close without saving changes
                Kill FolderPath & Filename ' Delete the file
                Application.DisplayAlerts = True
            Else
                ' Loop through all worksheets in the workbook to delete non-matching sheets
                Application.DisplayAlerts = False ' Suppress alerts for deleting sheets
                For Each ws In wb.Worksheets
                    wsName = ws.Name
                    If Not KeepSheets.exists(wsName) Then
                        ws.Visible = xlSheetVisible ' Make sheet visible if hidden
                        ws.Delete
                    End If
                Next ws
                Application.DisplayAlerts = True
                
                ' Save and close the workbook
                wb.Close SaveChanges:=True
            End If
        End If
        
        ' Get the next file
        Filename = Dir
    Loop
    
    MsgBox "Process Completed!", vbInformation
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question Question
remove columns from multiple Excel-files in a folder
Replies
5
Views
335
gjvv
G
R
  • Question Question
Add a code or number at the end of the file name using VBA (Looped)
Replies
3
Views
122
HighAndWilder
H
H
  • Question Question
Macro to List Folders excluding Data Stamp within E:\Cobian
Replies
0
Views
73
howard
H
D
  • Solved
VB search folder for older version of a file and move it to archive
Replies
7
Views
246
Davefromleeds
D
A
  • Question Question
How arrange files names based on modified date within folders and subfolders
Replies
4
Views
113
Alaa mg
A

Forum statistics

Threads
1,224,823
Messages
6,181,184
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top