Delete or rename an Excel file if it does not contain a sheet with a specific name

[Ovisele]

Hi Guys,

Please indulge me in the following problem. I need to parse over 700 files in order to establish if they contain or not a specific sheet "Corrective Saccades". If this particular sheet is present in the file, I would like to rename that file, or rename/delete the files that are not containing that specific sheet - whatever is easier.

An example file is here: Corrective Saccades.xlsx

Please see my piece of code below. Many thanks in advance!

Sub LoopFiles()

    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
   For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name = "Corrective Saccades" Then
           [B] WHAT DO I DO NEXT?[/B]
        End If
    Next
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    ActiveWorkbook.Save
    ActiveWorkbook.Close
            End With
            xFileName = Dir
        Loop
    End If
End Sub

 

[Oddball2020]

Hi Guys,

Please indulge me in the following problem. I need to parse over 700 files in order to establish if they contain or not a specific sheet "Corrective Saccades". If this particular sheet is present in the file, I would like to rename that file, or rename/delete the files that are not containing that specific sheet - whatever is easier.

An example file is here: Corrective Saccades.xlsx

Please see my piece of code below. Many thanks in advance!

Sub LoopFiles()

    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
   For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name = "Corrective Saccades" Then
           [B] WHAT DO I DO NEXT?[/B]
        End If
    Next
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    ActiveWorkbook.Save
    ActiveWorkbook.Close
            End With
            xFileName = Dir
        Loop
    End If
End Sub

I've done something similar. Hope this helps... you can see that the sheets you don't want deleted are in the IF Then statement as do-nothing... but the ELSE has the delete. Also key is to delete backwards through the sheet with Step -1, otherwise your sheet name association gets messed up and you'll delete the wrong sheets.

Dim SheetName As String
   
   i = Worksheets.Count
   
   For x = i To 1 Step -1
  
      Sheets(x).Activate
           
      SheetName = ActiveSheet.Name
     
      If SheetName = "Project TEMPLATE" Then
      ElseIf SheetName = "Issues Risks TEMPLATE" Then
      ElseIf SheetName = "Dash Board" Then
      ElseIf SheetName = "Admin" Then
     
      Else
        Application.DisplayAlerts = False
        Worksheets(x).Delete
        Application.DisplayAlerts = True
       
      End If
       
   Next x

Also to rename a sheet once you determine you don't want to delete it:

xWs.name = "New Name"

should work, or
xWs.Activate
Activesheet.name = "New Name"

 

[mumps]

This macro will re-name the files that do do contain the sheet by adding the word "OLD" to the file name.

Sub ReNameFiles()
    Application.ScreenUpdating = False
    Dim xFd As FileDialog, xFdItem As Variant, xFileName As String, oldfname As String, newfname As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                If Not Evaluate("isref('" & "Corrective Saccades" & "'!A1)") Then
                    oldfname = xFdItem & ActiveWorkbook.Name
                    newfname = xFdItem & "OLD " & ActiveWorkbook.Name
                    ActiveWorkbook.Close False
                    Name oldfname As newfname
                End If
            End With
            xFileName = Dir
        Loop
    End If
    Application.ScreenUpdating = True
End Sub

 

[Ovisele]

@Oddball2020
Thank you! But I do not want to rename the sheet, I want to delete the workbooks that are not containing that sheet altogether. Or, if it's easier, to copy those workbooks that are containing "Corrective Saccades" in another location. I hope that is more clear now.

 

[mumps]

I would like to rename that file, or rename/delete the files

I was responding to this comment you made in your original post. The macro doesn't re-name the sheet. It re-names the file.

 

[Oddball2020]

@Oddball2020
Thank you! But I do not want to rename the sheet, I want to delete the workbooks that are not containing that sheet altogether. Or, if it's easier, to copy those workbooks that are containing "Corrective Saccades" in another location. I hope that is more clear now.

My fault, mis-read that part... using the

KILL "File Path\File Name.xlsx"

command will delete the file

 

[Ovisele]

I was responding to this comment you made in your original post. The macro doesn't re-name the sheet. It re-names the file.

Yes, I am well aware, thank you so much. I am testing it now and seems to work flawless. Will be back with a resolution immediately. Many thanks again!

 

[Fluff]

If you want to delete the files try

Sub LoopFiles()

   Dim xFd As Object
   Dim xFdItem As Variant
   Dim xFileName As String
  
   Set xFd = Application.FileDialog(4)
   If xFd.Show = -1 Then
      xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
   End If
   xFileName = Dir(xFdItem & "*.xls*")
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   Do While xFileName <> ""
      With Workbooks.Open(xFdItem & xFileName)
         If ShtExists("Corrective Saccades", Workbooks(.Name)) Then
            .Close False
         Else
            .Close False
            Kill xFdItem & xFileName
         End If
         Application.DisplayAlerts = False
      End With
      xFileName = Dir
   Loop
End Sub
Public Function ShtExists(shtName As String, Optional Wbk As Workbook) As Boolean
    If Wbk Is Nothing Then Set Wbk = ActiveWorkbook
    On Error Resume Next
    ShtExists = (LCase(Wbk.Sheets(shtName).Name) = LCase(shtName))
    On Error GoTo 0
End Function

 

[Ovisele]

This macro will re-name the files that do do contain the sheet by adding the word "OLD" to the file name.

Sub ReNameFiles()
    Application.ScreenUpdating = False
    Dim xFd As FileDialog, xFdItem As Variant, xFileName As String, oldfname As String, newfname As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                If Not Evaluate("isref('" & "Corrective Saccades" & "'!A1)") Then
                    oldfname = xFdItem & ActiveWorkbook.Name
                    newfname = xFdItem & "OLD " & ActiveWorkbook.Name
                    ActiveWorkbook.Close False
                    Name oldfname As newfname
                End If
            End With
            xFileName = Dir
        Loop
    End If
    Application.ScreenUpdating = True
End Sub

Works like a charm! Thank you so very much! Deeply obliged!

 

[mumps]

You are very welcome.