Create Worksheets From Number List

[Small Paul]

Hi

I have a primary worksheet with rows which are numbered according to set criteria. The current list is '1, 2, 2, 3, 4, 5, 5' etc down to 23.

I have the following code which was posted by 'mumps' in 2015 (thank you mumps):

    Dim bottomA As Long    bottomA = Range("A" & Rows.Count).End(xlUp).Row
    Dim c As Range
    Dim ws As Worksheet
    For Each c In Range("A2:A" & bottomA)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(c.Value)
        On Error GoTo 0
        If ws Is Nothing Then
                Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
        End If
    Next c

It works great, with 1 exception - the first new worksheet created is named 3. So, sheets 3-23 have been created but not 1 and 2.

It is probably obvious to those of you who know what you are doing so any assistance would be greatly appreciated.

As an addition, is it possible to format ALL the worksheets in the same style in one go? For example, I need cells B12:L12 to be dark grey fill and cell B10 to be green.

Many thanks
Small Paul.

 

[mumps]

It's nice to see that some of my macros are still useful. Try this version:

Sub createSheets()
    Dim bottomA As Long
    bottomA = Range("A" & Rows.Count).End(xlUp).Row
    Dim c As Range
    Dim ws As Worksheet
    For Each c In Range("A2:A" & bottomA)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(CStr(c))
        On Error GoTo 0
        If ws Is Nothing Then
                Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
        End If
    Next c
End Sub

 

[Small Paul]

Hi mumps

That works perfectly - I now have new worksheets 1-23.
Thank you very much for the original macro and this update.

Are you able to suggest anything for my 2nd question? As an addition, is it possible to format ALL the worksheets in the same style in one go? For example, I need cells B12:L12 to be dark grey fill and cell B10 to be green.

Cheers
Small Paul.

 

[mumps]

Try:

Sub createSheets()
    Dim bottomA As Long
    bottomA = Range("A" & Rows.Count).End(xlUp).Row
    Dim c As Range
    Dim ws As Worksheet
    For Each c In Range("A2:A" & bottomA)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(CStr(c))
        On Error GoTo 0
        If ws Is Nothing Then
            Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
            Range("B10").Interior.ColorIndex = 4
            Range("B12:L12").Interior.ColorIndex = 48
        End If
    Next c
End Sub

 

[Small Paul]

Hi mumps

Absolutely perfect, thank you VERY much.

Cheers
Small Paul.

 

[mumps]

You are very welcome.