Help with Error Handling

[john3j]

Hello,

I am trying to figure out how to use error handling to skip and iteration. Here is my code:

Sub AddSheets(Host, Data1, Data2)
Set NewSht = Sheets.Add(after:=Sheets(Sheets.count), Type:=xlWorksheet)
'I know this is really bad practice for error handling and this is where I need help
On Error Resume Next
With NewSht
  .Name = Host
  .Range("A1").Value = Data1
  .Range("A2").Value = Data2
End With
End Sub

I am trying to prevent a new sheet being created with the same name as another sheet. Without the "On Error Resume Next" line, I get the following error:

Run-time error '1004':
Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic

I am using Microsoft Excel 2010. Any help would be greatly appreciated!

[jonh]

Sub AddSheets(Host, Data1, Data2)
    On Error Resume Next
    With Sheets.Add(after:=Sheets(Sheets.Count), Type:=xlWorksheet)
        If Err.Number Then
            'couldn't create sheet
        Else
            .Name = Host
            If Err.Number Then
                'error renaming
                Application.DisplayAlerts = 0
                .Delete
                Application.DisplayAlerts = 1
            else
                .Range("A1").Value = Data1 
                .Range("A2").Value = Data2
                If Err.Number Then
                    '... some error
                end if
            end if
        end if
    End With 
End Sub

[Kenneth Hobs]

You might check if the worksheet name exists before trying to add it.

Function Test_WorkSheetExists()  
  MsgBox "WorksheetExists? " & WorkSheetExists("Sheet1"), _
    vbInformation, "ActiveWorkbook.ActiveSheet"
End Function


 'WorkSheetExists in a workbook:
Function WorkSheetExists(sWorkSheet As String, Optional sWorkbook As String = "") As Boolean
    Dim ws As Worksheet, wb As Workbook
    On Error GoTo notExists
    If sWorkbook = "" Then
      Set wb = ActiveWorkbook
      Else
      Set wb = Workbooks(sWorkbook)
    End If
    Set ws = wb.Worksheets(sWorkSheet)
    WorkSheetExists = True
    Exit Function
notExists:
    WorkSheetExists = False
End Function

[john3j]

That seems to work great, but how would I get it to prompt when it is skipping a duplicate sheet? I tried adding in a MsgBox, but it didn't prompt.

On Error Resume Next
  With Sheets.Add(after:=Sheets(Sheets.count), Type:=xlWorksheet)
    If Err.Number Then
      MsgBox "The worksheet '" & Host & "' already exists and will be skipped."
    Else
        .Name = Host
        If Err.Number Then
            'error renaming
            Application.DisplayAlerts = 0
            .Delete
            Application.DisplayAlerts = 1

[Aflatoon]

The Error doesn't occur when you add the sheet, but when you rename it. You need to test Err.Number after that but Kenneth's method is preferable IMO.

[SamT]

If Err.Number <> 0 Then 
        MsgBox "The worksheet '" & Host & "' already exists and will be skipped." 
    Else

[Paul_Hossler]

Or maybe ...

Option Explicit

Sub AddSheets(Host As String, Data1 As Variant, Data2 As Variant)
    Dim wsExisting As Worksheet
    
    Set wsExisting = Nothing
    On Error Resume Next
    Set wsExisting = Worksheets(Host)
    On Error GoTo 0
    
    If Not wsExisting Is Nothing Then GoTo ExistsAlready
    
    'for some other reason
    On Error GoTo CannotCreate
    Sheets.Add after:=Sheets(Sheets.Count), Type:=xlWorksheet
    
    On Error GoTo CannotRename
    Sheets.Add after:=Sheets(Sheets.Count), Type:=xlWorksheet
        
    On Error GoTo SomeOtherError
    ActiveSheet.Range("A1").Value = Data1
    ActiveSheet.Range("A2").Value = Data2
    Exit Sub
ExistsAlready:
    MsgBox Host & " exists already"
    Exit Sub

SomeOtherError:
    MsgBox "ERROR!!! " & Err.Description & " (" & Err.Number & ")"
    Exit Sub

CannotRename:
    MsgBox "Cannot rename " & ActiveSheet.Name & " to " & Host
    Exit Sub

CannotCreate:
    MsgBox "Cannot create " & Host
    Exit Sub
End Sub

[Aflatoon]

@Paul
I think you mistyped the line to rename the sheet.

[jonh]

This got a bit ott so I gave up on it, but it provided different options for dealing with the name error, so I'll post it anyway.

Public Enum SheetExistsOption
    overwrite
    useexisting
    cancelupdate
    changename_auto
    changename_prompt
End Enum

Sub AddSheet()
On Error Resume Next
    Dim newS As Worksheet
    Set newS = NewSheet(NewWS_Name, ActiveWorkbook, SheetExistsOption.changename_prompt)
    
    If newS Is Nothing Then
        MsgBox "There was an error creating the new sheet :("
    Else
        With newS
            'hard coded ranges!
            AddData .Range("A1"), data1
            AddData .Range("A2"), data2
            
            'display msg if this 'special' one errors
            If Not AddData(.Range("A3"), data3) Then _
                MsgBox "Error adding data" & Err.Description, _
                    vbExclamation, "Error " & Err.Number
        End With
    End If
End Sub

Public Function NewSheet(ShtName As String, wb As Workbook, seo As SheetExistsOption) As Worksheet
On Error Resume Next
    If Not NameIsUnique(ShtName, wb) Then
        Select Case seo
        Case SheetExistsOption.cancelupdate
            Exit Function
        Case SheetExistsOption.changename_prompt
            Dim rv As String
            Do
                ShtName = Trim(InputBox("Sheet name:", "Enter new sheet name", ShtName))
                If ShtName = "" Then Exit Function
            Loop Until NameIsUnique(ShtName, wb)
        Case SheetExistsOption.changename_auto
            Dim i As Integer, tmps As String
            Do
                i = i + 1
                tmps = ShtName & "_" & i
                If NameIsUnique(tmps, wb) Then
                    ShtName = tmps
                    Exit Do
                End If
            Loop
        Case SheetExistsOption.overwrite
            Set NewSheet = wb.Sheets(ShtName)
            NewSheet.Cells.Delete
            Exit Function
        Case SheetExistsOption.useexisting
            Set NewSheet = wb.Sheets(ShtName)
            Exit Function
        End Select
    End If
    
    Set NewSheet = CreateNamedSheet(ShtName, wb)
End Function

Public Function CreateNamedSheet(ShtName As String, wb As Workbook) As Worksheet
On Error Resume Next
    Set CreateNamedSheet = wb.Sheets.Add(after:=Sheets(Sheets.Count), Type:=xlWorksheet)
        If Err.Number = 0 Then
            With CreateNamedSheet
                .Name = ShtName
                If Err.Number Then
                    CreateNamedSheet = Nothing
                    Application.DisplayAlerts = 0
                    .Delete
                    Application.DisplayAlerts = 1
                End If
            End With
        End If
End Function

Public Function NameIsUnique(ShtName As String, wb As Workbook) As Boolean
On Error Resume Next
    Dim newS As Worksheet
    Set newS = wb.Worksheets(ShtName)
    NameIsUnique = newS Is Nothing
End Function

Private Function AddData(rng As Range, val As Variant) As Boolean
On Error Resume Next
    rng = val
    If Err.Number Then
        Debug.Print "error setting", rng.Address, "to",
        Debug.Print val
        Debug.Print
    Else
        AddData = True
    End If
End Function

[SamT]

Jonh,

That could be an article or Blog entry.

[Paul_Hossler]

@Paul
I think you mistyped the line to rename the sheet.

A. It was a test to see if anyone was reading?

B. The kyebarerd was messed up?

C. I was copy/pasting too much?

D. Re-designing on the fly since I REALLY wasn't sure what the OP wanted for logic flow?



And the answer is ....




D




(probably)