Need Help Stopping Loop

[Divinedar]

I have a worksheet of about 388 items that each item is exported into a template worksheet that is created to itemize each item. It creates the worksheets but I can't get it to stop looping at the line of code in bold comments icons. The line that it stops at is to name the worksheet from the column "A" of the list of 388. I have shorten the list to work on the code. So when I'm done I would have workbook of 388 worksheets from the template made. The template worksheet name is "wbs_template" (hidden). I have attached an example of the workbook.

My other issue is that my IF STATEMENT is skipping lines if I use "1" in it. But if I change it to any other number it creates a wbs item for each item in the worksheet and I can't figure that out either.

Someone please help.

"Sub RenameNewSheet()

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim MyCell As Range, MyRange As Range, wsSource As Worksheet, i As Integer, MyDate, Lastrow As Integer, Newsht As String

    Set MyRange = Worksheets("WBS_Items").Range("tableinfo")
    Set MyCell = Worksheets("WBS_Items").Range("WBSNUM")

    Set wsSource = Worksheets("WBS_Items")

    Lastrow = wsSource.Cells(Rows.Count, 1).End(xlUp).Row

    wsSource.Range("A9:Q" & Lastrow).Select

    For Each MyCell In MyRange
    For i = 1 To Lastrow
    Cells(i, 1).Select

    If Cells(i, 1).Value <= 1 Then

            Worksheets("wbs_template").Visible = True
            Sheets("wbs_template").Select
            Sheets("wbs_template").Copy before:=Sheets("Rates")
            Worksheets("wbs_template").Visible = False
            Sheets("wbs_template (2)").Select
            Sheets("wbs_template (2)").Name = "Newsht"
            Sheets("Newsht").Activate
            Range("N8").Value = MyRange.Cells(i, 1) 'Adds WBS Number from column A
            Range("E8").Value = Sheets("PROJECT_INFORMATION").Range("A2")
            MyDate = Sheets("PROJECT_INFORMATION").Range("G2")
            Range("G8").Value = MyDate
            Range("I8").Value = Sheets("PROJECT_INFORMATION").Range("D2")
            Range("A1").Select
            Sheets("Newsht").Name = MyRange.Cells(i, 1) ' renames the new worksheet
            ActiveSheet.Calculate

   ElseIf Cells(i, 1).Value = "" Then Exit For

  End If
   Next i
   Next MyCell

'    HideSheets

    RebuildSell

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

[xrjf]

I haven't tried your code, but instead of using wsSource.Cells(Rows.Count, 1).End(xlUp).Row, you could use .UsedRange. UsedRange knows really where the data ends.

[Divinedar]

So do you mean instead of using .End(xlUp).Row use .UsedRange?

[Divinedar]

My biggest problem I get to one line in the code and I get a Run-time error '1004' so I believe it putting that piece of code in the right place for it to get exit the loop after the last row in the column of the LASTROW. So not sure where to put it.

 Sheets("Newsht").Name = MyRange.Cells(i, 1) ' renames the new worksheet

[xrjf]

I can't reply to you as it is meant because the Excel Sheet you send is missing, for example, "WBS_Items" or "tableinfo" and so on. In this manner is impossible to know what the data is and what you're trying to do. If you please, you may complete all the information.

[Divinedar]

xrjf sorry for the delay in responding but we shut down during the holidays. I've tried once before to attach an attachment to this but it doesn't seem to let me. I'm going to try again and the main code is in Module 2. Let me know what you find out . I just can't get it to stop when it reaches the last line on the list. It errors out.

[Reverend Jim]

Try zipping it before you upload it.

[Divinedar]

Thank you Reverend Jim. The code is in Module 2.

[Divinedar]

Within the main WBS_Items worksheet there are items with blank Qtys' which has a tendency to cause an error. I need for the ones that are blank to be included but without error if possible. You'll understand once you run the code. The main menu is in ADD-INS.

[Divinedar]

So if the QTY is blank I need for it to add a "1" in cells D15 and a "1" in cells E15 only in the NEWSHT if QTY is blank in the WBS_Items worksheet.

[xrjf]

As far as I've reached (Sub Add_SP_Rec(WBSNum As String) changing the lines order (first format, then formula):

    Worksheets("SUMMARY").Cells(lastRow, 1).Select
    Selection.NumberFormat = "00.000"
    Selection.Formula = WBSITEMNUMBER
    WBSITEMNUMBER = "=IF('" & WBSNum & "'!T$44<>0,'" & WBSNum & "'!N$8,"""")"

solves first error. Next change it's name to the function below or to variable lastRow, because variable lastRow is losing its value.

Function lastRow(shtname As Worksheet)
    Dim sh As Worksheet
    On Error Resume Next
    Set sh = Sheets(shtname)
    lastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

Also, for some reason cell's text is #N/A, so the next line of code throws an error:

iSheetString = iSheet.Cells(lastRow, 1).Value

[xrjf]

Forget all what I said. You just have to add two lines to Module1 in Function copy_template(Newsht As String):

Sheets(Newsht).Cells(44, 20) = 0
Sheets(Newsht).Cells(45, 20) = 0

So the function now will be:

Function copy_template(Newsht As String)
 Dim MyDate
MyDate = Sheets("PROJECT_INFORMATION").Range("G2")
    ShowSheets
    Worksheets("wbs_template").Visible = True
    Sheets("wbs_template").Select
    Sheets("wbs_template").Copy before:=Sheets("Rates")
    Worksheets("wbs_template").Visible = False
    Sheets("wbs_template (2)").Select
    Sheets("wbs_template (2)").Name = Newsht
    Sheets(Newsht).Activate
    Sheets(Newsht).Cells(23, 6) = "1"
    Range("E8").Value = Sheets("PROJECT_INFORMATION").Range("A2")
    Range("G8").Value = MyDate
    Range("N8").Value = Newsht
    Range("N8").Select
    Range("I8").Value = Sheets("PROJECT_INFORMATION").Range("D2")
    Range("A1").Select
    Sheets(Newsht).Cells(23, 6) = "0"
    Sheets(Newsht).Cells(44, 20) = 0
    Sheets(Newsht).Cells(45, 20) = 0
    applydata
    HideSheets
End Function