VBA code - naming sheets according to items in a list, but also ensuring no sheet duplications

Question

I am perplexed. I have a workbook which is used as a template for parts of the business as a register. The users build a list of register items they are tracking. For each item in the main register I need to create a worksheet that provides more detail on the issue. The new sheets are copies of a template also in the workbook "TemplateCRA". The create action is done using a single macro when all entreis have been made or updated in the register sheet "Ownership"

I started with this which works:

Sub Button1_Click()
'
' Button1_Click Macro
'
    Dim MyCell As Range, MyRange As Range

        Set MyRange = Sheets("Ownership").Range("B11:B30")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))

    For Each MyCell In MyRange
        If IsEmpty(MyCell) Then End
        Sheets("TemplateCRA").Copy After:=Sheets(Sheets.Count) 'creates a new worksheet
        Sheets(Sheets.Count).Name = "CRA Ref " & MyCell.Value ' renames the new worksheet
        Range("B6").Value = ActiveSheet.Name

    Next MyCell
End Sub

Then I progressed to this in an attempt to ensure that the macro first checks that a sheet has not already been created for the registered item, and if so alerts the user, but then continues to cycle down the items list and creates and new sheets required.

Sub Button2_Click()
    '
    ' Button2_Click Macro
    '
    Dim MyCell As Range, MyRange As Range
    Dim sh As Worksheet, flg As Boolean
    Set MyRange = Sheets("Ownership").Range("B11:B30")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
    For Each MyCell In MyRange
            If IsEmpty(MyCell) Then End

            For Each sh In Worksheets
                If sh.Name Like "CRA Ref " & MyCell.Value Then flg = True: Exit For
            Next
            If flg = True Then
                MsgBox sh.Name & " Found!"
            ElseIf flg = False Then
                MsgBox "Creating CRA Ref " & MyCell.Value & " now!"
                Sheets("TemplateCRA").Copy After:=Sheets(Sheets.Count) 'creates a new worksheet
                Sheets(Sheets.Count).Name = "CRA Ref " & MyCell.Value ' renames the new worksheet
                Range("B6").Value = ActiveSheet.Name
            End If

    Next MyCell
    MsgBox "You may now complete your CRA for each item"
End Sub

But this doesnt work properly. What appears to happen is that :

the sh.Name check cycles through OK reporting that sheets are found until it finds an item without a sheet reports a Run Time error 91 - object variable with block variable not set in the first MsgBox line.

Can anyone suggest what I have wrong?

Cheers

Larry · Answer 1 · 2013-01-24T08:51:24.393

The problem is you didn't initilize your flg in the outer for loop. Thus, for the 2nd loop, the default value of flg is TRUE, it loops through the inner for each loop and can't find the sh, sh --> empty--> runtime error

fix to your code:

Sub Button2_Click()
    '
    ' Button2_Click Macro
    '
    Dim MyCell As Range, MyRange As Range
    Dim sh As Worksheet, flg As Boolean
    Set MyRange = Sheets("Ownership").Range("B11:B30")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
    For Each MyCell In MyRange
            If IsEmpty(MyCell) Then
               exit for
            end if
            flg = False ' init the flg each time
            For Each sh In Worksheets
                'Changed Like --> = to ensure the worksheet exists
                If sh.Name = "CRA Ref " & MyCell.Value Then
                    flg = True
                    Exit For
                End If
            Next
            If flg = True Then
                MsgBox sh.Name & " Found!"
            ElseIf flg = False Then
                MsgBox "Creating CRA Ref " & MyCell.Value & " now!"
                Sheets("TemplateCRA").Copy After:=Sheets(Sheets.Count) 'creates a new worksheet
                Sheets(Sheets.Count).Name = "CRA Ref " & MyCell.Value ' renames the new worksheet
                Range("B6").Value = ActiveSheet.Name
            End If

    Next MyCell
    MsgBox "You may now complete your CRA for each item"
End Sub

I never use "END" in my own code, it's inherited from OP's post. Thanks for the reading and I'm change it now. @SiddharthRout — Larry, Jan 24 '13 at 08:50
sure, I'm just pointing the problem, too lazy to re-factor the code. — Larry, Jan 24 '13 at 09:01
Thanks very much - both answers worked - I'll be incorporating bets of both and can now see my error. — user2006320, Jan 25 '13 at 02:32

score 2 · Answer 2 · edited May 23 '17 at 10:34

Four Things

Please avoid the use of End. See this link
Use of xlDown to find the last row can be very dicey. See this link on how @brettdj explained it.
See this link on how to get the last row.
You can check if a sheet exists or not in just few lines. Looping through worksheets is not necessary.

I have not tested the code but it should work. If you get any error, just let me know which line is giving you the error and we will take it from there.

Sub Button1_Click()
    Dim ws As Worksheet, wsTemp As Worksheet
    Dim MyCell As Range, MyRange As Range
    Dim LRow As Long

    Set ws = ThisWorkbook.Sheets("Ownership")

    With ws
        LRow = .Range("B" & .Rows.Count).End(xlUp).Row

        Set MyRange = .Range("B11:B" & LRow)

        For Each MyCell In MyRange
            If Len(Trim(MyCell.Value)) <> 0 Then
                On Error Resume Next
                Set wsTemp = ThisWorkbook.Sheets("CRA Ref " & MyCell.Value)
                On Error GoTo 0

                If wsTemp Is Nothing Then '<~~ Sheet doesn't exists
                    ThisWorkbook.Sheets("TemplateCRA").Copy After:=ThisWorkbook.Sheets(Sheets.Count)
                    ThisWorkbook.Sheets(Sheets.Count).Name = "CRA Ref " & MyCell.Value
                Else '<~~ Sheet exists
                    MsgBox "sheet exists"
                End If

                set wsTemp = nothing

            End If
        Next MyCell
    End With
End Sub

Thanks very much - both answers worked - I'll be incorporating bets of both and can now see my error. — user2006320, Jan 25 '13 at 02:30

VBA code - naming sheets according to items in a list, but also ensuring no sheet duplications

2 Answers2