How do I create a vbYesNo MsgBox outside of For Each loop?

user_15237989 0
Viewed 53

What I'm trying to do:

If sheets exist that are NOT named "Macro" > prompt user with MsgBox > if yes, delete all sheets not named "Macro"

But only show MsgBox ONCE (do not show MsgBox for each sheet if more than 1 sheet exists)

Problem with current code: Still getting MsgBox prompt when "Macro" is the only sheet that exists.

Current code:

Sub reset()
    
    Dim conditionMet As Boolean
    Dim answer      As Integer
    
    conditionMet = FALSE
    answer = MsgBox("There Is already data here. Click Yes To delete reset macro.", vbQuestion + vbYesNo)
    
    Application.DisplayAlerts = FALSE
    
    For Each Sheet In ThisWorkbook.Worksheets
        If Sheet.Name <> "Macro" Then
            conditionMet = TRUE
        Else
            Exit Sub
        End If
    Next Sheet
    
    If conditionMet Then
        If answer = vbYes Then
            Sheet.Delete
        Else
            Exit Sub
        End If
    Else
        Exit Sub
    End If
    
    Application.DisplayAlerts = TRUE
    
End Sub
vba excel
2 Answers

Here's one approach:

Const KEEP_THIS As String = "Macro"
Dim ws As Worksheet

On Error Resume Next
Set ws = ThisWorkbook.Sheets(KEEP_THIS)
On Error GoTo 0
If ws Is Nothing Or ThisWorkbook.Worksheets.Count = 1 Then Exit Sub 'no "Macro" sheet

If MsgBox("Delete all data sheets?", vbQuestion + vbYesNo) <> vbYes Then Exit Sub
'remove all non-Macro sheets
For i = ThisWorkbook.Worksheets.Count To 1 Step -1
    With ThisWorkbook.Worksheets(i)
        If .Name <> KEEP_THIS Then .Delete
    End With
Next i
user_4788840

Delete All Sheets Except a Specified One

  • The following shows how to avoid a few (less) common surprises.

The Code

Option Explicit

Sub resetWorkbook()
    
    Const SheetName As String = "Macro"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' There has to be at least one sheet in the workbook.
    If wb.Sheets.Count = 1 Then Exit Sub
    
    ' Check for existence.
    On Error Resume Next
    Dim sh As Object: Set sh = wb.Sheets(SheetName)
    On Error GoTo 0
    If sh Is Nothing Then Exit Sub
    
    If MsgBox("There Is already data here. Click Yes To delete reset macro.", _
        vbQuestion + vbYesNo) = vbNo Then Exit Sub
    
    ' An only sheet in a workbook has to be visible.
    If Not sh.Visible = xlSheetVisible Then
        sh.Visible = xlSheetVisible
    End If
    
    ' Write the other sheet names to an array.
    Dim SheetNames() As String: ReDim SheetNames(1 To wb.Sheets.Count - 1)
    Dim n As Long
    For Each sh In wb.Sheets
        ' Allow case-insensitivity i.e. A = a.
        If StrComp(sh.Name, SheetName, vbTextCompare) <> 0 Then
            n = n + 1
            SheetNames(n) = sh.Name
        End If
    Next sh
    
    ' Delete sheets in one go with no pop-ups.
    Application.DisplayAlerts = False
    wb.Sheets(SheetNames).Delete
    Application.DisplayAlerts = True
    
    ' Inform.
    MsgBox "Number of sheets deleted: " & n, vbInformation, "Success"
    
End Sub
user_98140690
Related