Logit, this is close. I dont want the spreadsheet named with "Confidential.xlsx" at the end. I just want to keep the spreadsheet name the same. This actually double the amount of spreadsheets in the folder because it updated the current spreadsheet with the new Confidential.xslx and left the current spreadsheet without changes in the folder. If we can get "Confidential.xslx removed and just update the spreadsheet without changing the name that would be awesome. Thanks! Here is a pic of how it doubles the spreadsheets btw
Option Explicit
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
Application.DisplayAlerts = False
' 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
wb.Close SaveChanges:=False ' Close without saving changes
Kill FolderPath & Filename ' Delete the file
Else
' Loop through all worksheets in the workbook to delete non-matching 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
' Save the workbook with a 'Confidential' setting
Dim SavePath As String
SavePath = FolderPath & wb.Name '---> got rid of this & "_Confidential.xlsx"
' Add a custom document property to indicate confidentiality
On Error Resume Next
wb.CustomDocumentProperties.Add Name:="Confidential", _
LinkToContent:=False, Type:=msoPropertyTypeString, Value:="True"
On Error GoTo 0
' Save the workbook
wb.SaveAs Filename:=SavePath, FileFormat:=xlOpenXMLWorkbook
wb.Close SaveChanges:=False
End If
End If
' Get the next file
Filename = Dir
Loop
Application.DisplayAlerts = True
MsgBox "Process Completed!", vbInformation
End SubHi Logit, I now get a runtime error when I use this code. Run-time error '1004': Cant Access the spreadsheet.
Set the folder path
FolderPath = "C:\Your\Folder\Path\" ' Change this to your folder pathYes I used the same exact path I just double checked. It just gives that error 1004 and it gives the name of the very first spreadsheet in the folder and says it cant access it.
I also noticed that the first spreadsheet where this error pops up now only shows the tabs needed correctly, it just never applied the Sensitivity Label of Confidential to the spreadsheet, so that looks to be the spot where the code errored out at. I showed you the "Debug" pic above.
FolderPath = "C:\Your\Folder\Path\" ' Change this to your folder pathI mean I am using the same path I have used prior to get to the Folder that resides in My Documents. I am not just using the generic example you provided.
