CODEWITHSUNDEEP
excelvba
user3860954
user3860954

Reputation: 99

Macro go to a folder and delete sheets entered by user in all XLS sheets

Here is my working code, I just want user to prompt for tab name, so that user can pick which tab to delete:

Sub LoopAllExcelFilesInFolder()

'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)

    'Change First Worksheet's Background Fill Blue
      'wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)
      wb.Worksheets(2).Delete

    'Save and Close Workbook
      wb.Close SaveChanges:=True

    'Get next file name
      myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Upvotes: 2

Views: 1987

Answers (2)

kolcinx
kolcinx

Reputation: 2233

FreeMan's answer one step further (with multiple sheets to be deleted).

New variables

Dim DelSheets() As String 'array
Dim intDelSheetCount As Integer
Dim DelSht As Variant

New loop for user promt

'ask user multiple times, which sheets he wants to delete
Do
ReDim Preserve DelSheets(intDelSheetCount)
DelSheets(intDelSheetCount) = InputBox(Prompt:="Enter the name of the sheet to delete")
intMsgBoxAnswer = MsgBox("Do you want to type more sheets to be deleted?", vbYesNo)
intDelSheetCount = intDelSheetCount + 1
Loop While intMsgBoxAnswer = 6 'while the answer is YES

Deletion loop

  For Each sht In wb.Sheets
    For Each DelSht In DelSheets
        If sht.Name = DelSht Then
          DelSht.Delete
        End If
    Next DelSht
  Next

Additional settings

To get rid of the Excel popup question, if you are super sure if you want to delete the sheet, you can use Application.DisplayAlerts = False at the beginning of the sub.

Upvotes: 1

FreeMan
FreeMan

Reputation: 5687

Add these variables (or similar) to the top of your code.

Dim DelSheet as string
Dim sht as worksheet

Get the sheet name - this is an example, you can get it from the user however you want

DelSheet = InputBox(Prompt:="Enter the name of the sheet to delete")

Modify this portion of your code, above. Leave the rest as is, since it seems to be working ok.

Do While myFile <> ""
  'Set variable equal to opened workbook
  Set wb = Workbooks.Open(Filename:=myPath & myFile)

  'this loop isn't particularly efficient, but it prevents attempting
  'deletion of the sheet if that sheet doesn't exist in the wb
  'you could wrap the code in an "On Error..." block instead
  for each sht in wb.sheets
    if sht.name = DelSheet then
      wb.Worksheets(DelSheet).Delete
    endif
  next

  'Save and Close Workbook
  wb.Close SaveChanges:=True

'Get next file name
  myFile = Dir
Loop

Upvotes: 1

Related Questions