Johnny Norton
Johnny Norton

Reputation: 21

Add new worksheet named after values in a column only if they don't already exist

I am struggling to get this code right. I need to create a new worksheet for every city that is listed in column A of my worksheet called "AllCities", but only if the name of that city doesn't already exist as a worksheet. Right now my code will run but it will still add new worksheets to the end and not name them, when it should only add the last couple cities listed in the column. My current code is below.

Sub CreateSheetsFromAList()

    Dim MyCell As Range
    Dim MyRange As Range

    With Sheets("AllCities").Range("A2")
    Set MyRange = Sheets("AllCities").Range("A2")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))

    For Each MyCell In MyRange

        On Error Resume Next

        Sheets.ADD After:=Sheets(Sheets.Count) 'creates a new worksheet
        Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet

        If Err.Number = 1004 Then
            Debug.Print MyCell.Value & "already used as sheet name"
        End If
        On Error GoTo 0   
    Next MyCell
    End With  

End Sub

Upvotes: 2

Views: 75

Answers (1)

user4039065
user4039065

Reputation:

I find it easier to just start working on the worksheet whether it is there or not. Judicious error control will pause processing when attempted on a non-existent worksheet and allow error control to create one.

Sub CreateSheetsFromAList()
    Dim myCell As Range, myRange As Range

    With Sheets("AllCities")
        Set myRange = Sheets("AllCities").Range("A2")
        Set myRange = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))

        For Each myCell In myRange
            On Error GoTo bm_Need_Worksheet
            With Worksheets(myCell.Value)
                'work on the worksheet here
            End With
        Next myCell
    End With

    Exit Sub
bm_Need_Worksheet:
    With Worksheets.Add(after:=Sheets(Sheets.Count))
        'trap an error on bad worksheet name
        On Error GoTo 0
        .Name = myCell.Value
        'prep the worksheet
        .Cells(1, 1).Resize(1, 9).Formula = "=""fld ""&SUBSTITUTE(ADDRESS(1,COLUMN(), 4, 1), 1, """")"
        With ActiveWindow
            .Zoom = 80
            .SplitColumn = 0
            .SplitRow = 1
            .FreezePanes = True
        End With
    End With
    Resume
End Sub

The key here is the Resume statement on the trapped error. It brings code execution back to the line that threw the error and continues processing from there.

Upvotes: 1

Related Questions