Naming Worksheets - Loop within a loop issue

[Guest]

Hi,

I'm having a heck of a time with this macro which I've (gratefully) had way
too much help from in this Discussion Group... The problem is with Excel's
inherent bug of not being able to use the "copy after" method to (upon
enacting a macro) programatically create worksheets from a list in my summary
sheet using more then 20 names. After creating 20 names, Excel points to
"copy after method" as causing the macro to trip. To remedy this issue, Susan
helped me create a loop with a userform to have the user choose the next 15
names to propagate into worksheets. However, I already had looping code,
which is now sandwiched between Susan's loop. Now the nested loop is not
controlled by Susan's loop. I'm not sure how to update code (from Jim
Thomlinson , Dave Peterson, Bob, Phillips, and Tom Ogilvy) to be compatible
with Susan's looping code. Any help from you Excel wizards would be much
appreciated!

Other informatin is the following: 1) The code pasted behind my macro
button, which calls up the userform, is ok; I've create a worksheet called
"Number", which is hidden and referenced in the code; and all variables are
dimmed in another module (module 1).

Here is the code:


'**Start Susan's code
Option Explicit

Sub userform_initialize()

Set sTotal = ActiveWorkbook.Worksheets("Number").Range("b3")
myVar = sTotal.Value

lblLastTime.Caption = myVar
refStartRange.Value = ""
refStartRange.SetFocus

End Sub

Sub cmdCancel_click()

Unload Me

End Sub


Sub cmdContinue_click()

If refStartRange.Value = "" Then
MsgBox "Please select a row from the spreadsheet." _
, vbOKOnly + vbInformation
Exit Sub
End If

Application.ScreenUpdating = False
Application.DisplayAlerts = False

MyRow = Range(refStartRange.Value).Row

V = MyRow + 15
n = MyRow
Do Until n = V
'**End Susan's code

'**Start Jim's, Bob's Tom's and Dave's code)
Set ws = ActiveSheet
Set LastCell = ws.Cells(Rows.Count, "c").End(xlUp)
Set Rng = ws.Range("c15", LastCell)
For Each cell In Rng
If Not IsEmpty(cell) Then
Set ws = Nothing
On Error Resume Next
Set ws = Worksheets(cell.Value)
On Error GoTo 0
If ws Is Nothing Then
Sheets("Master").Visible = True
Sheets("Master").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = cell.Value & "(" & cell.Offset(0,
1).Value & ")"

cell.Hyperlinks.Add Anchor:=cell, _
Address:="", _
SubAddress:="'" & ActiveSheet.Name & "'!A1", _
TextToDisplay:=cell.Value
Sheets("Master").Visible = False
End If
End If
Next

End Sub
'**End Jim's, Bob's Tom's and Dave's code)

'**Start Susan's code
n = n + 1
Loop

'change the label caption = V & save on hidden sheet "Number"
myVar = V - 1
sTotal = myVar

Unload Me

With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False

If MsgBox("15 worksheets have been added." _
& vbCrLf & _
vbCrLf & _
"The workbook will now save and close, ok?" _
, vbYesNo + vbQuestion) = vbYes Then
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True

Else
MsgBox "You will not be able to add additional worksheets" _
& vbCrLf & _
"until the workbook is closed and saved.", _
vbOKOnly + vbInformation
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End If
End Sub
'**End Susan's code

Thanks in advance!

 

[Guest]

I figured I needed to get my three sense into this problem. I been looking
at it all morninging and since none of the other experts responed I DID.
Since Jim's, Bob's Tom's and Dave's code was working I removed some Susan's
code but used her ideas.


Sub cmdContinue_click()

StartCell = InputBox("Enter Start cell(""C15"")")
addcount = 0
'**Start Jim's, Bob's Tom's and Dave's code)
Set ws = ActiveSheet
Set LastCell = ws.Cells(Rows.Count, "c").End(xlUp)
Set Rng = ws.Range(StartCell, LastCell)
For Each cell In Rng
If Not IsEmpty(cell) Then
Set ws = Nothing
On Error Resume Next
Set ws = Worksheets(cell.Value)
On Error GoTo 0
If ws Is Nothing Then

If addcount >= 15 Then

If MsgBox("15 worksheets have been added." _
& vbCrLf & _
"Restart next time at cell C" & cell.Row & vbCrLf & _
vbCrLf & _
"The workbook will now save and close, ok?" _
, vbYesNo + vbQuestion) = vbYes Then
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Else
MsgBox _
"You will not be able to add additional worksheets" _
& vbCrLf & _
"until the workbook is closed and saved.", _
vbOKOnly + vbInformation
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End If

End If

Sheets("Master").Visible = True
Sheets("Master").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = cell.Value & "(" & cell.Offset(0,
1).Value & ")"

cell.Hyperlinks.Add Anchor:=cell, _
Address:="", _
SubAddress:="'" & ActiveSheet.Name & "'!A1", _
TextToDisplay:=cell.Value
Sheets("Master").Visible = False
addcount = addcount + 1
End If
End If
Next

End Sub

 

[Guest]

Made some minor changess. this code runs provided the cells in column C15
are text (not a number). I changed the Hyperlink because the name of the
worksheet and the name in the link was failing.

Sub xyz()
StartCell = InputBox("Enter Start cell(""C15"")")
addcount = 0
'**Start Jim's, Bob's Tom's and Dave's code)
Set ws = ActiveSheet
Set LastCell = ws.Cells(Rows.Count, "c").End(xlUp)
Set Rng = ws.Range(StartCell, LastCell)
For Each cell In Rng
If Not IsEmpty(cell) Then
Set ws = Nothing
On Error Resume Next
Set ws = Worksheets(cell.Value)
On Error GoTo 0
If ws Is Nothing Then

If addcount >= 15 Then

If MsgBox("15 worksheets have been added." _
& vbCrLf & _
"Restart next time at cell C" & cell.Row & vbCrLf & _
vbCrLf & _
"The workbook will now save and close, ok?" _
, vbYesNo + vbQuestion) = vbYes Then
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Else
MsgBox _
"You will not be able to add additional worksheets" _
& vbCrLf & _
"until the workbook is closed and saved.", _
vbOKOnly + vbInformation
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End If

End If

Sheets("Master").Visible = True
MySheetName = cell.Value & "(" & cell.Offset(0, 1).Value & ")"
Sheets("Master").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = MySheetName

cell.Hyperlinks.Add Anchor:=cell, _
Address:="", _
SubAddress:="'" & MySheetName & "'!A1", _
TextToDisplay:=cell.Value
Sheets("Master").Visible = False
addcount = addcount + 1
End If
End If
Next

End Sub

 

[Susan]

I figured I needed to get my three sense into this problem. I been looking
at it all morninging and since none of the other experts responed I DID.
Since Jim's, Bob's Tom's and Dave's code was working I removed some Susan's
code but used her ideas.

joel - thanks for helping kent!!! i'm glad at least my ideas were
useful (even if the code wasn't!).
susan

 

[Guest]

It is best on the discussion group to keep solution as simple as possible.
You don't know the lelel of expertese of the people who are making the
postings. I spoon feed the information. I like to give them the simple
solution and tell them some enhancements that can be made later. Then if
they respond wanting to know how to do the enhancement I will reply.

You had great ideas to fully automat Klysell problem, but he didn't
underrstand all the steps and didn't get the code working.

 

[Guest]

Hi Joel and Susan,

Thanks again for your help. I've finally got the workaround for the loop
within a loop problem. A number of Excel experts, including yourselves, have
been amazing in helping me out (and saving my neck with my current contract
which is ending on Friday thank goodness!). I've definitely reached beyond my
grasp regarding understanding Excel VBA, and I've certainly learned a lot
from you guys. I endeavor to read some recommended Excel books to improve my
understanding and to contribute to this Discussion Group.

I'll post the final solution so that others can benefit from circumventing
this known issue in Excel.

Many thanks,
Kent.