VBA to add new Sheets

DrH100

Board Regular
Joined
Dec 30, 2011
Messages
59
Good evening all

I have some code which i have borrowed to add some new sheets to a workbook based on the contents of column a. The code is

HTML:
Sub AddSheets()
Dim cell As Excel.Range
Dim wsWithSheetNames As Excel.Worksheet
Dim wbToAddSheetsTo As Excel.Workbook

Set wsWithSheetNames = ActiveSheet
Set wbToAddSheetsTo = ActiveWorkbook
For Each cell In wsWithSheetNames.Range("A2:A5")
    With wbToAddSheetsTo
        .Sheets.Add after:=.Sheets(.Sheets.Count)
        On Error Resume Next
        ActiveSheet.Name = cell.Value
        If Err.Number = 1004 Then
          Debug.Print cell.Value & " already used as a sheet name"
        End If
        On Error GoTo 0
    End With
Next cell
End Sub
which works to a point but what I would like to do is only create the new tab if

a) there is something in the cell in column a (ie it might only be a1:a15 or the next time i run it it might be a1:a30

At the moment I get a lot of sheets named sheet 16, 17, 18 etc etc and it is creating too many but ti need the potential to add more if needed.

and

b) if that tab does not already exist.

any help amending this code would be great or pointing in a different direction.

Thanks for any help in advance
 

iggydarsa

Well-known Member
Joined
Jun 28, 2005
Messages
1,647
Rich (BB code):
Sub AddSheets()
Dim cell As Excel.Range
Dim wsWithSheetNames As Excel.Worksheet
Dim wbToAddSheetsTo As Excel.Workbook
Dim lr As Long: lr = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Dim found As Boolean: found = False

Set wsWithSheetNames = ActiveSheet
Set wbToAddSheetsTo = ActiveWorkbook
For Each cell In wsWithSheetNames.Range("A2:A" & lr)
    found = False
    With wbToAddSheetsTo
        For Each sh In Worksheets
            If sh.Name = CStr(cell.Value) Then
                found = True
                Exit For
            End If
        Next sh
        If Not found And cell.Value <> "" Then
            On Error Resume Next
            .Sheets.Add after:=.Sheets(.Sheets.Count)
            ActiveSheet.Name = cell.Value
        End If
    End With
Next cell
End Sub
 

Forum statistics

Threads
1,082,585
Messages
5,366,466
Members
400,892
Latest member
lamarh755

Some videos you may like

This Week's Hot Topics

Top