CODEWITHSUNDEEP
excelvbscriptvba
Joe
Joe

Reputation: 405

Rename excel worksheet if sheet already exist

In the code below, I am attempting to create a new sheet called "Summary". However, if the "Summary" sheet already exists, I get an error. How do I simply add a new sheet, called "Summary X" (where X is 1, or 2, or 3, or...), if a "Summary" sheet already exists. That is, each time I run the code, a new "Summary X" sheet will be added with no errors. In this case, if the code is run the second time, there will be a Summary and Summary 1 tab and so on....

Here is the code:

Sub SearchFolders()
'UpdatebySUPERtoolsforExcel2016
    Dim xFso As Object
    Dim xFld As Object
    Dim xStrSearch As String
    Dim xStrPath As String
    Dim xStrFile As String
    Dim xOut As Worksheet
    Dim xWb As Workbook
    Dim xWk As Worksheet
    Dim xRow As Long
    Dim xFound As Range
    Dim xStrAddress As String
    Dim xFileDialog As FileDialog
    Dim xUpdate As Boolean
    Dim xCount As Long
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a forlder"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    xStrSearch = "failed"
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  ' Create the report sheet at first position then name it "Summary"
  Dim wsReport As Worksheet, rCellwsReport As Range
  Set wsReport = ThisWorkbook.Sheets.Add(Before:=ThisWorkbook.Sheets(1))
  wsReport.Name = "Summary"
  Set rCellwsReport = wsReport.Cells(2, 2)
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    xUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    Set xOut = wsReport
    xRow = 1
    With xOut
        .Cells(xRow, 1) = "Workbook"
        .Cells(xRow, 2) = "Worksheet"
        .Cells(xRow, 3) = "Cell"
        .Cells(xRow, 4) = "Test"
        .Cells(xRow, 5) = "Limit Low"
        .Cells(xRow, 6) = "Limit High"
        .Cells(xRow, 7) = "Measured"
        .Cells(xRow, 8) = "Unit"
        .Cells(xRow, 9) = "Status"
    End With

    MsgBox xCount & "cells have been found", , "SUPERtools for Excel"
ExitHandler:
    Set xOut = Nothing
    Set xWk = Nothing
    Set xWb = Nothing
    Set xFld = Nothing
    Set xFso = Nothing
    Application.ScreenUpdating = xUpdate
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

Upvotes: 0

Views: 1702

Answers (1)

BruceWayne
BruceWayne

Reputation: 23285

Here's a quick sub you can modify to fit your needs:

Sub setSheets()
Dim ws As Worksheet, wsReport
Dim i As Long

For Each ws In ActiveWorkbook.Worksheets
    If ws.Name Like "Summary*" Then
        i = i + 1
    End If
Next ws

Set wsReport = ThisWorkbook.Sheets.Add
If i > 0 Then
    wsReport.Name = "Summary" & i + 1
Else
    wsReport.Name = "Summary"
End If

End Sub

Upvotes: 2

Related Questions