CODEWITHSUNDEEP
vbaexcel
Lucas Senne
Lucas Senne

Reputation: 19

How to create if condition to create excel sheets

I am trying to create a VBE Code to create a new excel worksheet.

To create a new worksheet I am using the code below and is working really fine:

    Dim ws As Worksheet
    With ThisWorkbook
        Set ws = .Sheets.Add(After:=.Sheets(.Sheets.count))
        ws.Name = "Savings"
    End With

But now I need to change this code to an IF condition that will work on this logic: if there is a worksheet with the name "Savings" delete it and create a new worksheet Named "Savings" else just create the sheet "Savings".

After I create the worksheet "Savings" I want to save as a new file and I would like to suggest a name (like Savings) in the name field of the save as dialog box.

Thank you guys for always helping me

Upvotes: 0

Views: 621

Answers (3)

tigeravatar
tigeravatar

Reputation: 26650

Something like this should work for you:

Sub tgr()

    Dim wsSav As Worksheet
    Dim sSavePath As String
    Dim sExt As String
    Dim lFileFormat As Long

    With ThisWorkbook
        On Error Resume Next    'Prevent error if worksheet doesn't exist
        Set wsSav = .Sheets("Savings")
        On Error GoTo 0         'Remove error condition

        If Not wsSav Is Nothing Then
            Application.DisplayAlerts = False   'Suppress "Are you sure?" worksheet delete prompt
            wsSav.Delete
            Application.DisplayAlerts = True
        End If
        Set wsSav = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        wsSav.Name = "Savings"

        sSavePath = Application.GetSaveAsFilename("Savings")
        If sSavePath = "False" Then Exit Sub    'user pressed cancel

        sExt = Mid(sSavePath, InStrRev(sSavePath, ".") + 1)
        If Len(sExt) = 0 Then
            sExt = "xlsm"
            sSavePath = sSavePath & sExt
        End If

        Select Case LCase(sExt)
            Case "xlsm":    lFileFormat = 52
            Case "xlsx":    lFileFormat = 51
            Case "xls":     lFileFormat = 56
            Case Else:
                MsgBox "Invalid Excel file extension """ & sExt & """" & Chr(10) & _
                       "Unable to save file."
                Exit Sub
        End Select

        Application.DisplayAlerts = False   'Suppress overwrite prompt (if any)
        .SaveAs sSavePath, lFileFormat
        Application.DisplayAlerts = True
    End With

End Sub

Upvotes: 0

Tom
Tom

Reputation: 9878

This will set the worksheet to your variable and test if it exists. If it does it will delete it before using your code to create the new sheet. The nice thing about this way is you don't require a loop to achieve it

Dim ws as worksheet

On Error Resume Next
Set ws = ThisWorkbook.Sheets("Savings")
On Error GoTo 0

If not ws is nothing then
    With Application
        ' Disable Alerts
        .DisplayAlerts = False
        ' Delete sheet
        ws.delete
        ' Re-enable Alerts
        .DisplayAlerts = True
    End With
End If

With ThisWorkbook
    Set ws = .Sheets.Add(After:=.Sheets(.Sheets.count))
    ws.Name = "Savings"
End With

Upvotes: 1

gizlmo
gizlmo

Reputation: 1922

This should do the trick:

Dim ws As Worksheet
With ThisWorkbook
    For Each ws In .Worksheets
        If ws.Name = "Savings" Then 'If Savings exists
            Application.DisplayAlerts = False 'Disable warnings
            ws.Delete 'Delete Worksheet
            Application.DisplayAlerts = True 'Enable warnings
            Exit For
        End If
    Next ws

    'Add Savings Worksheet
    Set ws = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
    ws.Name = "Savings"
End With

With Application.FileDialog(msoFileDialogSaveAs) 'SaveAs Dialog
    .InitialFileName = "Savings" 'Suggested Name
    .AllowMultiSelect = False

    .Show
    If .SelectedItems.Count > 0 Then
        ThisWorkbook.SaveAs .SelectedItems(1) 'Save File
    End If
End With

Upvotes: 0

Related Questions