CODEWITHSUNDEEP
excelvba
Thomas Meier
Thomas Meier

Reputation: 49

VBA to create sheets based on a list

I would like to automatically create sheets based on a list in sheet "Clients". This sheet has the names of clients (starting from cell A2) and the VBA code is reading this list and creates a sheet per cell value.

I found some code on this forum but it throws a 'Run-time error 450: Wrong number of arguments or invalid property assignment' on row 9 (Set MyRange2 = .Range(MyRange, .Rows.Count, "A").End(xlUp)). I'm not a VBA developer so searching for this error didn't really mean a lot to me. What could be wrong with this code?

Sub insertSheets()

Dim myCell As Range
Dim MyRange As Range
Dim MyRange2 As Range

With Sheets("Clients")
    Set MyRange = .Range("A2")
    Set MyRange2 = .Range(MyRange, .Rows.Count, "A").End(xlUp)
End With

For Each myCell In MyRange2
    If Not myCell.Value = vbNullString Then
        Sheets.Add After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = myCell.Value
    End If
Next myCell

End Sub

Thanks for the help

Upvotes: 2

Views: 2672

Answers (1)

VBasic2008
VBasic2008

Reputation: 54983

Add Worksheets From a List

The Mistake

Set MyRange2 = .Range(MyRange, .Cells(.Rows.Count, "A").End(xlUp))
' or (no need for 'Set MyRange = .Range("A2")'):
'Set MyRange2 = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))

An Improvement

Option Explicit

Sub InsertSheets()

    Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets("Clients")
    
    Dim srg As Range
    Set srg = sws.Range("A2", sws.Cells(sws.Rows.Count, "A").End(xlUp))
    
    Dim sCell As Range
    Dim sValue As Variant
    Dim dws As Worksheet
    Dim wsCount As Long
    Dim ErrNum As Long
    
    For Each sCell In srg.Cells
        sValue = sCell.Value
        If Not IsError(sValue) Then ' ignore error values
            sValue = CStr(sValue)
            If Len(sValue) > 0 Then ' ignore blanks
                On Error Resume Next
                    Set dws = ThisWorkbook.Worksheets(sValue)
                On Error GoTo 0
                If dws Is Nothing Then
                    Set dws = ThisWorkbook.Worksheets.Add( _
                        After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                    On Error Resume Next
                        dws.Name = sValue
                        ErrNum = Err.Number
                    On Error GoTo 0
                    If ErrNum = 0 Then ' valid name
                        wsCount = wsCount + 1
                    Else ' invalid name; delete the worksheet
                        Application.DisplayAlerts = False
                            dws.Delete
                        Application.DisplayAlerts = True
                    End If
                ' Else ' worksheet already exists; do nothing
                End If
                Set dws = Nothing
            ' Else ' is blank; do nothing
            End If
        ' Else ' is error value; do nothing
        End If
    Next sCell

    MsgBox "Worksheets created: " & wsCount

End Sub

Upvotes: 3

Related Questions