I need this macro to be a little more robust. It works but only up to
26. Could it be the computer I'm on? If I change the range in the
patient's sheet to only c1:c26 this macro works without a hitch. If I
add any more rows it crashes. i need it to copy all the sheets and
get this done. It is rather urgent. Can I use an array instead of a
loop. Any ideas?
many thanks,

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

Set wb = ThisWorkbook
Set ws = wb.Worksheets("patients")
Set ws = ThisWorkbook.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
Debug.Print lngLastRow
Set rng = ws.Range("C1:C" & lngLastRow)

inputDate = InputBox("Enter a date:", "Date", Date)
For Each c In rng.Cells

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

ws.Range("T5") = inputDate
sStr = c
Lname = Mid(sStr, InStr(1, sStr, " ") + 1)
ws.Name = Lname
Next c
End Sub

[Ken Cowen]

Your macro worked fine for me in Excel 2003. I was able to create 500 worksheets, one for Patient 1 through Patient 500. What version are you using? Is it possible that the 27th patient name has a character that leads to an invalid worksheet name? What is the error that you get?

Ken

Hello Janis
Cannot be too definite but it looks like it is the computer your are working
on: it has probably reached the maximum available memory ressource and
cannot go on.

HTH
Cordially
Pascal

"Janis R" <(E-Mail Removed)> a écrit dans le message de news:
0af45aab-7537-4ef6-8e44-90088c2f7150...oglegroups.com...
>I need this macro to be a little more robust. It works but only up to
> 26. Could it be the computer I'm on? If I change the range in the
> patient's sheet to only c1:c26 this macro works without a hitch. If I
> add any more rows it crashes. i need it to copy all the sheets and
> get this done. It is rather urgent. Can I use an array instead of a
> loop. Any ideas?
> many thanks,
>
> 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
>
> Set wb = ThisWorkbook
> Set ws = wb.Worksheets("patients")
> Set ws = ThisWorkbook.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
> Debug.Print lngLastRow
> Set rng = ws.Range("C1:C" & lngLastRow)
>
> inputDate = InputBox("Enter a date:", "Date", Date)
> For Each c In rng.Cells
>
> wb.Sheets(2).Copy before:=wb.Sheets(2)
> Set ws = wb.Sheets(2)
>
> ws.Range("T5") = inputDate
> sStr = c
> Lname = Mid(sStr, InStr(1, sStr, " ") + 1)
> ws.Name = Lname
> Next c
> End Sub

This problem actually occurs on most any computer that I've used. The
problem is the worksheet.copy command. There are a couple workarounds:

1. Create a blank sheet, then use copy/paste (special) to recreate the
copied sheet.
2. Create a template of the sheet to be copied, and insert a new sheet based
on the template.

The second is better, because it makes a complete copy.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
Peltier Technical Services, Inc. - http://PeltierTech.com
_______


"papou" <(E-Mail Removed)> wrote in message
news:OLdOB$(E-Mail Removed)...
> Hello Janis
> Cannot be too definite but it looks like it is the computer your are
> working on: it has probably reached the maximum available memory ressource
> and cannot go on.
>
> HTH
> Cordially
> Pascal
>
> "Janis R" <(E-Mail Removed)> a écrit dans le message de news:
> 0af45aab-7537-4ef6-8e44-90088c2f7150...oglegroups.com...
>>I need this macro to be a little more robust. It works but only up to
>> 26. Could it be the computer I'm on? If I change the range in the
>> patient's sheet to only c1:c26 this macro works without a hitch. If I
>> add any more rows it crashes. i need it to copy all the sheets and
>> get this done. It is rather urgent. Can I use an array instead of a
>> loop. Any ideas?
>> many thanks,
>>
>> 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
>>
>> Set wb = ThisWorkbook
>> Set ws = wb.Worksheets("patients")
>> Set ws = ThisWorkbook.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
>> Debug.Print lngLastRow
>> Set rng = ws.Range("C1:C" & lngLastRow)
>>
>> inputDate = InputBox("Enter a date:", "Date", Date)
>> For Each c In rng.Cells
>>
>> wb.Sheets(2).Copy before:=wb.Sheets(2)
>> Set ws = wb.Sheets(2)
>>
>> ws.Range("T5") = inputDate
>> sStr = c
>> Lname = Mid(sStr, InStr(1, sStr, " ") + 1)
>> ws.Name = Lname
>> Next c
>> End Sub
>
>

Hello Jon
Thanks for that, so its definitely not a memory issue.
Is the error always occuring above 26 copies ?

Cordially
Pascal

"Jon Peltier" <(E-Mail Removed)> a écrit dans le message de
news: (E-Mail Removed)...
> This problem actually occurs on most any computer that I've used. The
> problem is the worksheet.copy command. There are a couple workarounds:
>
> 1. Create a blank sheet, then use copy/paste (special) to recreate the
> copied sheet.
> 2. Create a template of the sheet to be copied, and insert a new sheet
> based on the template.
>
> The second is better, because it makes a complete copy.
>
> - Jon
> -------
> Jon Peltier, Microsoft Excel MVP
> Tutorials and Custom Solutions
> Peltier Technical Services, Inc. - http://PeltierTech.com
> _______
>
>
> "papou" <(E-Mail Removed)> wrote in message
> news:OLdOB$(E-Mail Removed)...
>> Hello Janis
>> Cannot be too definite but it looks like it is the computer your are
>> working on: it has probably reached the maximum available memory
>> ressource and cannot go on.
>>
>> HTH
>> Cordially
>> Pascal
>>
>> "Janis R" <(E-Mail Removed)> a écrit dans le message de news:
>> 0af45aab-7537-4ef6-8e44-90088c2f7150...oglegroups.com...
>>>I need this macro to be a little more robust. It works but only up to
>>> 26. Could it be the computer I'm on? If I change the range in the
>>> patient's sheet to only c1:c26 this macro works without a hitch. If I
>>> add any more rows it crashes. i need it to copy all the sheets and
>>> get this done. It is rather urgent. Can I use an array instead of a
>>> loop. Any ideas?
>>> many thanks,
>>>
>>> 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
>>>
>>> Set wb = ThisWorkbook
>>> Set ws = wb.Worksheets("patients")
>>> Set ws = ThisWorkbook.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
>>> Debug.Print lngLastRow
>>> Set rng = ws.Range("C1:C" & lngLastRow)
>>>
>>> inputDate = InputBox("Enter a date:", "Date", Date)
>>> For Each c In rng.Cells
>>>
>>> wb.Sheets(2).Copy before:=wb.Sheets(2)
>>> Set ws = wb.Sheets(2)
>>>
>>> ws.Range("T5") = inputDate
>>> sStr = c
>>> Lname = Mid(sStr, InStr(1, sStr, " ") + 1)
>>> ws.Name = Lname
>>> Next c
>>> End Sub
>>
>>
>
>

On Jan 22, 10:10 am, "Jon Peltier" <jonxlmv...@SPAMpeltiertech.com>
wrote:
> This problem actually occurs on most any computer that I've used. The
> problem is the worksheet.copy command. There are a couple workarounds:
>
> 1. Create a blank sheet, then use copy/paste (special) to recreate the
> copied sheet.
> 2. Create a template of the sheet to be copied, and insert a new sheet based
> on the template.
>
> The second is better, because it makes a complete copy.
>
> - Jon
> -------
> Jon Peltier, Microsoft Excel MVP
> Tutorials and Custom Solutions
> Peltier Technical Services, Inc. -http://PeltierTech.com
> _______
>
> "papou" <cpapounospamth...@lapostenospamthanks.net> wrote in message
>
> news:OLdOB$(E-Mail Removed)...
>
> > Hello Janis
> > Cannot be too definite but it looks like it is the computer your are
> > working on: it has probably reached the maximum available memory ressource
> > and cannot go on.
>
> > HTH
> > Cordially
> > Pascal
>
> > "Janis R" <jlro...@yahoo.com> a écrit dans le message de news:
> > 0af45aab-7537-4ef6-8e44-90088c2f7...@e23g2000prf.googlegroups.com...
> >>I need this macro to be a little more robust. It works but only up to
> >> 26. Could it be the computer I'm on? If I change the range in the
> >> patient's sheet to only c1:c26 this macro works without a hitch. If I
> >> add any more rows it crashes. i need it to copy all the sheets and
> >> get this done. It is rather urgent. Can I use an array instead of a
> >> loop. Any ideas?
> >> many thanks,
>
> >> 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
>
> >> Set wb = ThisWorkbook
> >> Set ws = wb.Worksheets("patients")
> >> Set ws = ThisWorkbook.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
> >> Debug.Print lngLastRow
> >> Set rng = ws.Range("C1:C" & lngLastRow)
>
> >> inputDate = InputBox("Enter a date:", "Date", Date)
> >> For Each c In rng.Cells
>
> >> wb.Sheets(2).Copy before:=wb.Sheets(2)
> >> Set ws = wb.Sheets(2)
>
> >> ws.Range("T5") = inputDate
> >> sStr = c
> >> Lname = Mid(sStr, InStr(1, sStr, " ") + 1)
> >> ws.Name = Lname
> >> Next c
> >> End Sub

Sometimes an Excel workbook bloats to a huge file size when multiple
sheets are copied to it. Especially if the target workbook is a
master and refilled repeatedly. I've had relatively compact workbooks
sheetwise engorge to 10MB from this. And that obviously becomes an
opportunity for memory dysfunction. When this happens, the file size
will not decrease even if you delete most of the worksheets. The only
work arounds I've found are to copy the cell contents and then paste
as values into the target workbook that has a template sheet pre-
formatted. The other is to copy the target sheets to a new workbook
in order the leave the bloat behind. So check your target workbook
size too for this possibility.

Perhaps Jon or somebody else here has more info on this phenomenon.

SteveM

Depends on the sheet. ISTR numbers like 29 or 39. Microsoft has actually
issued a KB article with a workaround, which goes like this: if you get the
error, save and close the workbook, reopen it, and continue.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
Peltier Technical Services, Inc. - http://PeltierTech.com
_______


"papou" <(E-Mail Removed)> wrote in message
news:%(E-Mail Removed)...
> Hello Jon
> Thanks for that, so its definitely not a memory issue.
> Is the error always occuring above 26 copies ?
>
> Cordially
> Pascal
>
> "Jon Peltier" <(E-Mail Removed)> a écrit dans le message de
> news: (E-Mail Removed)...
>> This problem actually occurs on most any computer that I've used. The
>> problem is the worksheet.copy command. There are a couple workarounds:
>>
>> 1. Create a blank sheet, then use copy/paste (special) to recreate the
>> copied sheet.
>> 2. Create a template of the sheet to be copied, and insert a new sheet
>> based on the template.
>>
>> The second is better, because it makes a complete copy.
>>
>> - Jon
>> -------
>> Jon Peltier, Microsoft Excel MVP
>> Tutorials and Custom Solutions
>> Peltier Technical Services, Inc. - http://PeltierTech.com
>> _______
>>
>>
>> "papou" <(E-Mail Removed)> wrote in message
>> news:OLdOB$(E-Mail Removed)...
>>> Hello Janis
>>> Cannot be too definite but it looks like it is the computer your are
>>> working on: it has probably reached the maximum available memory
>>> ressource and cannot go on.
>>>
>>> HTH
>>> Cordially
>>> Pascal
>>>
>>> "Janis R" <(E-Mail Removed)> a écrit dans le message de news:
>>> 0af45aab-7537-4ef6-8e44-90088c2f7150...oglegroups.com...
>>>>I need this macro to be a little more robust. It works but only up to
>>>> 26. Could it be the computer I'm on? If I change the range in the
>>>> patient's sheet to only c1:c26 this macro works without a hitch. If I
>>>> add any more rows it crashes. i need it to copy all the sheets and
>>>> get this done. It is rather urgent. Can I use an array instead of a
>>>> loop. Any ideas?
>>>> many thanks,
>>>>
>>>> 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
>>>>
>>>> Set wb = ThisWorkbook
>>>> Set ws = wb.Worksheets("patients")
>>>> Set ws = ThisWorkbook.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
>>>> Debug.Print lngLastRow
>>>> Set rng = ws.Range("C1:C" & lngLastRow)
>>>>
>>>> inputDate = InputBox("Enter a date:", "Date", Date)
>>>> For Each c In rng.Cells
>>>>
>>>> wb.Sheets(2).Copy before:=wb.Sheets(2)
>>>> Set ws = wb.Sheets(2)
>>>>
>>>> ws.Range("T5") = inputDate
>>>> sStr = c
>>>> Lname = Mid(sStr, InStr(1, sStr, " ") + 1)
>>>> ws.Name = Lname
>>>> Next c
>>>> End Sub
>>>
>>>
>>
>>
>
>