CODEWITHSUNDEEP
vbaexcel
Assaf Baker
Assaf Baker

Reputation: 151

excel sheet creation and update

I am looking for a way to create sheets in excel based on a list of cells problem I have is that I would like the script to check if the list was updated and add the additional sheets and not re create all or delete the old copies

1) is it possible from excel (non VBA)

2) if not the code i have for creating a sheet is : but it will create new entrys if I re-run (and I am looking for update)

Sub AddSheets()
'Updateby Extendoffice 20161215
    Dim xRg As Excel.Range
    Dim wSh As Excel.Worksheet
    Dim wBk As Excel.Workbook
    Set wSh = ActiveSheet
    Set wBk = ActiveWorkbook
    Application.ScreenUpdating = False
    For Each xRg In wSh.Range("A1:A7")
        With wBk
            .Sheets.Add after:=.Sheets(.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xRg.Value
            If Err.Number = 1004 Then
              Debug.Print xRg.Value & " already used as a sheet name"
            End If
            On Error GoTo 0
        End With
    Next xRg
    Application.ScreenUpdating = True
End Sub

Upvotes: 0

Views: 885

Answers (2)

BruceWayne
BruceWayne

Reputation: 23283

Here's another option. I also added a part where it'll name the sheet the column A value. (You can remove that if needed). 

Sub AddSheets()
'Updateby Extendoffice 20161215
Dim xRg     As Excel.Range
Dim wSh     As Excel.Worksheet
Dim wBk     As Excel.Workbook
Set wSh = ActiveSheet
Set wBk = ActiveWorkbook
Application.ScreenUpdating = False
For Each xRg In wSh.Range("A1:A7")
    With wBk
        If Not sheetExists(xRg.Value) and xRg <> "" Then
            .Sheets.Add after:=.Sheets(.Sheets.Count)
            ActiveSheet.Name = xRg.Value
        End If
    End With
Next xRg
Application.ScreenUpdating = True
End Sub


Function sheetExists(sheetToFind As String) As Boolean
'http://stackoverflow.com/a/6040454/4650297
Dim sheet As Worksheet
sheetExists = False
For Each sheet In Worksheets
    If sheetToFind = sheet.Name Then
        sheetExists = True
        Exit Function
    End If
Next sheet
End Function

Upvotes: 2

dwirony
dwirony

Reputation: 5450

Use this function to check if the worksheet already exists, then let it skip over it.

Function WorksheetExists(sName As String) As Boolean
    WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")
End Function

So your code can be:

Sub AddSheets()
    'Updateby Extendoffice 20161215
    Dim xRg As Variant
    Dim wSh As Excel.Worksheet
    Dim wBk As Excel.Workbook
    Set wSh = ActiveSheet
    Set wBk = ActiveWorkbook
    Application.ScreenUpdating = False
    For Each xRg In wSh.Range("A1:A7")
        If Not IsError(xRg) Then
            If xRg <> "" Then
                If Not WorkSheetExists((xRg)) Then
                    With wBk
                       .Sheets.Add after:=.Sheets(.Sheets.Count)
                        ActiveSheet.Name = xRg.Value
                    End With
                End If
            End If
        End If
    Next xRg
    Application.ScreenUpdating = True
End Sub

Function WorksheetExists(sName As String) As Boolean
    WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")
End Function

Upvotes: 1

Related Questions