Macro to delete existing sheet

[cornepiek]

hi all

i need a macro to check what weekday it is based on cell value,
then to look for a sheet named for that day.

if cell valy is monday, look for sheet named monday.

if sheet exists, delete it, if not continue with operation.


please assist

 

[JamesW]

Hi,

Try:

Sub deleteSheets()
    Dim wkDay As String
    Application.DisplayAlerts = False
    wkDay = Format(Weekday(Range("A1").Value), "dddd")
    For Each sht In ThisWorkbook.Sheets
        If sht.Name = wkDay Then sht.Delete
    Next
    Application.DisplayAlerts = True
End Sub

Edit: The above will work if you have a date in cell A1.

 

[JackDanIce]

This assumes the cell value (in A1) being tested is in the first worksheet and the weekday sheets follow this:

Sub DeleteMyNoggin ()
 
Dim i as Long
Dim DeleteValue as string
 
Application.ScreenUpdating = False
 
DeleteValue = Sheets(1).Range("A1")
On Error Resume Next
For i = 2 to Worksheets.Count
  If sheets(i).Name = DeleteValue Then
     Sheets(i).Delete
     Exit For
  End If
Next i
 
On Error Goto 0
Application.ScreenUpdating = True 
End Sub

 

[cornepiek]

HI jack

you macro works, though i am prompted that sheet might contain data.

is there a way to bypass this prompt?

 

[JackDanIce]

Change my code to:

Sub EatinMePenguin()
 
Dim i As Long
Dim DeleteValue As String
 
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .Calculation = xlCalculationManual
End With
 
DeleteValue = Sheets(1).Range("A1")

On Error Resume Next

For i = 2 To Worksheets.Count
  If Sheets(i).Name = DeleteValue Then
     Sheets(i).Delete
     Exit For
  End If
Next i
 
On Error GoTo 0
 
With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .Calculation = xlCalculationAutomatic
End With
 
End Sub

 

[cornepiek]

works like a charm

thanks

 

[JackDanIce]

You're welcome

 

[brettdj]

You could make this small addition to Jacks's code to delete the sheet immediately. This removes the loop

Cheers

Dave

Sub EatinMePenguin2()
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    On Error Resume Next
    ThisWorkbook.Sheets(Sheets(1).Range("A1").Value).Delete
    On Error GoTo 0
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub