memory limit on the number of sheets created

[Janis R.]

It definitely didn't on my excel2003 mac at all ever, but I could
test the whole thing on my pc tomorrow at work.
Thanks for checking. It was stopping on the line before next c where
it assigns the name of the sheet. I am wondering if it had something
to do with the form or something hidden? I don't think so though, The
interesting thing is the user slightly changed what they wanted. I
use the same loop and same variables I just print after I copy and I
delete the sheet after I print it instead of saving all of them. It
works knock on wood. Maybe that proves it was a memory problem
although it copies all of them just the same it just deletes them
during each iteration. Wow it was like one thing worked today 24
hours to late but it worked.

 

[kounoike]

How about to try adding a sheet and copy all cells to the added sheet
insted of copying a sheet.

I tried to modify your code according to above, though i don't know it work
or not in your case.

Sub ModifycpyAllPatientsShts()
Dim lngLastRow As Long
Dim ws As Worksheet
Dim wb As Workbook
Dim c As Range
Dim rng As Range
Dim sStr As String, Lname As String
Dim inputDate As Date
Dim p

Set wb = ThisWorkbook
Set ws = wb.Worksheets("patients")

'lngLastRow = Cells(Rows.Count, "c").End(xlUp).Row
' lngLastRow = ws.Cells.Find(What:="*", After:=ws.Range("C1"), _
SearchDirection:=xlPrevious).Row
lngLastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set rng = ws.Range("C1:C" & lngLastRow)
Debug.Print lngLastRow
inputDate = InputBox("Enter a date:", "Date", Date)

On Error GoTo errhandle

wb.Sheets(2).Copy before:=wb.Sheets(2)

For Each c In rng.Cells
errcount = 0
wb.Worksheets.Add before:=Sheets(2)
wb.Sheets(3).Cells.Copy Destination:=Sheets(2).Range("a1")
Set ws = wb.Sheets(2)
ws.Range("T5") = inputDate
sStr = c
Lname = Mid(sStr, InStr(1, sStr, " ") + 1)

'check valid sheet name and length
For Each p In Array("[", "]", ":", "*", "/", "?", _
Application.PathSeparator)
If InStr(Lname, p) > 0 Then
Lname = Replace(Lname, p, "_")
End If
Next
If Len(Lname) > 31 Then
Lname = Left(Lname, 31)
End If
ws.Name = Lname
Next c

Exit Sub

errhandle:
If Err.Number = 1004 Then
p = Split(Lname, " -")
If UBound(p) > 0 Then
If Len(p(0)) + Len(p(1) + 1) + 2 > 31 Then
p(0) = Left(p(0), 31 - Len(p(1)) - 3)
Lname = Left(p(0), 31 - Len(p(1)) - 3) _
& Space(1) & "-" & Trim(Val(p(1)) + 1)
Else
Lname = p(0) & Space(1) & "-" & Trim(Val(p(1)) + 1)
End If
ElseIf Len(Lname) = 31 Then
Lname = Left(Lname, 31 - 3) & Space(1) & "-1"
Else
Lname = Lname & Space(1) & "-1"
End If
Else
MsgBox "Unexpected error occured"
Exit Sub
End If
Resume
End Sub

keiji

Okay, the error I get is runtime error 1004, copy method of worksheet
failed.
Here is the code. I don't see anything that isn't dimensioned.
Public Sub cpyAllPatientsShts()

-snip-

 

[dgbyrne]

How about to try adding asheetandcopyall cells to the addedsheet
insted of copying asheet.

I tried to modify your code according to above, though i don't know it work
or not in your case.

Sub ModifycpyAllPatientsShts()
Dim lngLastRow As Long
Dim ws As Worksheet
Dim wb As Workbook
Dim c As Range
Dim rng As Range
Dim sStr As String, Lname As String
Dim inputDate As Date
Dim p

Set wb = ThisWorkbook
Set ws = wb.Worksheets("patients")

'lngLastRow = Cells(Rows.Count, "c").End(xlUp).Row
' lngLastRow = ws.Cells.Find(What:="*", After:=ws.Range("C1"), _
SearchDirection:=xlPrevious).Row
lngLastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, _
    SearchDirection:=xlPrevious).Row
Set rng = ws.Range("C1:C" & lngLastRow)
Debug.Print lngLastRow
inputDate = InputBox("Enter a date:", "Date", Date)

On Error GoTo errhandle

wb.Sheets(2).Copybefore:=wb.Sheets(2)

For Each c In rng.Cells
    errcount = 0
    wb.Worksheets.Add before:=Sheets(2)
    wb.Sheets(3).Cells.CopyDestination:=Sheets(2).Range("a1")
    Set ws = wb.Sheets(2)
    ws.Range("T5") = inputDate
    sStr = c
    Lname = Mid(sStr, InStr(1, sStr, " ") + 1)

    'check validsheetname and length
    For Each p In Array("[", "]", ":", "*", "/", "?", _
        Application.PathSeparator)
        If InStr(Lname, p) > 0 Then
            Lname = Replace(Lname, p, "_")
        End If
    Next
    If Len(Lname) > 31 Then
        Lname = Left(Lname, 31)
    End If
    ws.Name = Lname
Next c

Exit Sub

errhandle:
If Err.Number = 1004 Then
    p = Split(Lname, " -")
    If UBound(p) > 0 Then
        If Len(p(0)) + Len(p(1) + 1) + 2 > 31 Then
            p(0) = Left(p(0), 31 - Len(p(1)) - 3)
            Lname = Left(p(0), 31 - Len(p(1)) - 3) _
                & Space(1) & "-" & Trim(Val(p(1)) + 1)
        Else
            Lname = p(0) & Space(1) & "-" & Trim(Val(p(1)) +1)
        End If
    ElseIf Len(Lname) = 31 Then
        Lname = Left(Lname, 31 - 3) & Space(1) & "-1"
    Else
        Lname = Lname & Space(1) & "-1"
    End If
Else
    MsgBox "Unexpected error occured"
    Exit Sub
End If
Resume
End Sub

keiji

Okay, the error I get is runtime error 1004,copymethod of worksheet
failed.
Here is the code.  I don't see anything that isn't dimensioned.
Public Sub cpyAllPatientsShts()

-snip-

Back again after a while...........

The REAL issue here is NOT that there is a limit to the number of
sheets that can be CREATED with a macro.

It is INSTEAD, and MORE importantly the number of times a sheet can be
copied WITHIN a file by a macro.!!

I hit the same block, read the link to the MS issue, Accepted this as
a REAL limit and built a very simple and effective work around.

I have a two-sheet file with the sheet I wish to copy as one.

When I need a new copy of the sheet, I (in code), open the file, copy
the sheet into my specified location, these close that "Slave" file.

Works like a dream!

Accept that there really are limits, and unless you have LOTS of spare
time, build a workaround!!

Particularly when you are TOLD by Bill's slaves that this is an
acknowledged issue.