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!
--
Kent Lysell
Financial Consultant
Ottawa, Ontario
W: 613.943.9098
|
Similar Threads
