0

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
Assaf Baker
  • 151
  • 1
  • 1
  • 8

2 Answers2

2

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
BruceWayne
  • 22,923
  • 15
  • 65
  • 110
1

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
Mathieu Guindon
  • 69,817
  • 8
  • 107
  • 235
dwirony
  • 5,487
  • 3
  • 21
  • 43
  • it works but i get a "type mismatch" error on each execution – Assaf Baker May 15 '17 at 21:17
  • Yup, I just fixed it. I had to change xRg to a variant instead of a range so that the function could take the argument. Try the updated code now. – dwirony May 15 '17 at 21:18
  • 1
    Why do you have a "do nothing" block? Invert the condition and remove the redundant `Else`! ..and the redundant `Else` in the outer condition, too! ...and fix the indentation, too. – Mathieu Guindon May 15 '17 at 21:20
  • Note that `Rx <> ""` will blow up with a *type mismatch* when `IsError(Rx)` is true. – Mathieu Guindon May 15 '17 at 21:22
  • Ha sorry I tried editing from mobile and the formatting was completely lost – dwirony May 15 '17 at 21:23
  • sorry but not it dosent run at all - with the excel range it did – Assaf Baker May 15 '17 at 21:25
  • The function will never take the argument of the null string, so wheres the concern? – dwirony May 15 '17 at 21:25
  • What null string? If the data (which the procedure doesn't control and is subject to user's whim) contains `#REF!` errors, or any other error value, comparing such a range against an empty string raises a run-time error (and ultimately spawns a new Stack Overflow question, that then gets closed as a duplicate). – Mathieu Guindon May 15 '17 at 21:28
  • Ah I see. I interpreted what he said earlier of a cell having "no value" as being blank. That being said, I'd hope he's using ISERROR to negate those #REF cells. Sorry, posting from mobile is tough- – dwirony May 15 '17 at 21:35