The workbooks and macros used are being created in Excel 2007, but saved in the
97-2003 format.

I have a macro that the boss will use to enter employees and place the
names, date added, and count (sequential) into a worksheet. It loops in case
there is more than one name to be added.

NOTE: The boss will be in workbook(QA Master.xls)

Once the boss is through entering names, the macro will then loop and create
a workbook, copying the Workbook("QA Template.xls") and renaming it with the
employee name that was entered.

I don't know why, but I am getting the following error on the line that
copies and names the new workbook:
Runtime Error 9
Subscript Out of Range

The macro is below:

Option Base 1
'Add Employee to list and create workbook for employee
Private Sub CommandButton2_Click()
Dim Employee(1 To 200), Msg, Title As String 'Array may not reach 200
entries
Dim Config, num, k As Integer
Dim Ans1, Ans2, cnt As Integer
Dim rng As Range
num = 1 'Tracks number of employees entered. Becomes actual UBound of array
myPath = ThisWorkbook.Path
ADDEMP:
Employee(num) = InputBox("Enter Employee's Name (First or Middle, Last
Name)", "ADD EMPLOYEE")
If Employee(num) = "" Or Left(Employee(num), 1) = " " Then
MsgBox ("Invalid Entry. Please enter employee's name.")
Employee(num) = ""
GoTo ADDEMP
End If
Msg = "Is the employee's name correctly entered?"
Msg = Msg & vbNewLine & vbNewLine
Msg = Msg & Employee(num)
Config = vbYesNo + vbQuestion
Title = "VERIFY ENTRY"
Ans1 = MsgBox(Msg, Config, Title)
If Ans1 = vbNo Then
Employee(num) = ""
GoTo ADDEMP
End If
'Validation of Entry Complete
'Proceed to place data in cells
Set rng = Range("I65536").End(xlUp).Offset(1, 0)
rng.Select
rng.Value = Employee(num)
rng.Offset(0, -1).Value = Date 'Place DATE employee added into cell
If rng.Offset(-1, -2).Value = "NUM" Then 'Determine if this is first line
in list
cnt = 1 'If YES, cnt = 1
Else
cnt = rng.Offset(-1, -2).Value 'Pick up last number entered (total
employees to date)
cnt = cnt + 1 'Add one to last count in employee list
End If
rng.Offset(0, -2).Value = cnt 'cnt serves as a count on number of employees
in list.
Msg = "Do you want to enter another employee?"
Config = vbYesNo + vbQuestion
Title = "CONTINUE"
Ans2 = MsgBox(Msg, Config, Title)
If Ans2 = vbYes Then
num = num + 1
GoTo ADDEMP
End If
'Create workbook for each employee entered
For k = 1 To num
Workbooks("QA Template.xls").SaveAs Filename:=myPath & "\" & Employee(k)
& ".xls"
Next k
End Sub

I appreciate any help with this.

Les

Subscript out of range means that there is nothing by that name in the
collection that you're looking at.

This set of lines:

For k = 1 To num
Workbooks("QA Template.xls").SaveAs _
Filename:=myPath & "\" & Employee(k) & ".xls"
Next k

will save the "QA template.xls" workbook with a new name. That means that there
is no longer an open workbook with that name.

Without any testing at all, I'd try:

For k = 1 To num
Workbooks("QA Template.xls").SaveCOPYAs _
Filename:=myPath & "\" & Employee(k) & ".xls"
Next k

..SaveCopyAs won't touch the original workbook's name.


WLMPilot wrote:

The workbooks and macros used are being created in Excel 2007, but saved in the
97-2003 format.

I have a macro that the boss will use to enter employees and place the
names, date added, and count (sequential) into a worksheet. It loops in case
there is more than one name to be added.

NOTE: The boss will be in workbook(QA Master.xls)

Once the boss is through entering names, the macro will then loop and create
a workbook, copying the Workbook("QA Template.xls") and renaming it with the
employee name that was entered.

I don't know why, but I am getting the following error on the line that
copies and names the new workbook:
Runtime Error 9
Subscript Out of Range

The macro is below:

Option Base 1
'Add Employee to list and create workbook for employee
Private Sub CommandButton2_Click()
Dim Employee(1 To 200), Msg, Title As String 'Array may not reach 200
entries
Dim Config, num, k As Integer
Dim Ans1, Ans2, cnt As Integer
Dim rng As Range
num = 1 'Tracks number of employees entered. Becomes actual UBound of array
myPath = ThisWorkbook.Path
ADDEMP:
Employee(num) = InputBox("Enter Employee's Name (First or Middle, Last
Name)", "ADD EMPLOYEE")
If Employee(num) = "" Or Left(Employee(num), 1) = " " Then
MsgBox ("Invalid Entry. Please enter employee's name.")
Employee(num) = ""
GoTo ADDEMP
End If
Msg = "Is the employee's name correctly entered?"
Msg = Msg & vbNewLine & vbNewLine
Msg = Msg & Employee(num)
Config = vbYesNo + vbQuestion
Title = "VERIFY ENTRY"
Ans1 = MsgBox(Msg, Config, Title)
If Ans1 = vbNo Then
Employee(num) = ""
GoTo ADDEMP
End If
'Validation of Entry Complete
'Proceed to place data in cells
Set rng = Range("I65536").End(xlUp).Offset(1, 0)
rng.Select
rng.Value = Employee(num)
rng.Offset(0, -1).Value = Date 'Place DATE employee added into cell
If rng.Offset(-1, -2).Value = "NUM" Then 'Determine if this is first line
in list
cnt = 1 'If YES, cnt = 1
Else
cnt = rng.Offset(-1, -2).Value 'Pick up last number entered (total
employees to date)
cnt = cnt + 1 'Add one to last count in employee list
End If
rng.Offset(0, -2).Value = cnt 'cnt serves as a count on number of employees
in list.
Msg = "Do you want to enter another employee?"
Config = vbYesNo + vbQuestion
Title = "CONTINUE"
Ans2 = MsgBox(Msg, Config, Title)
If Ans2 = vbYes Then
num = num + 1
GoTo ADDEMP
End If
'Create workbook for each employee entered
For k = 1 To num
Workbooks("QA Template.xls").SaveAs Filename:=myPath & "\" & Employee(k)
& ".xls"
Next k
End Sub

I appreciate any help with this.

Les

--

Dave Peterson

For k = 1 To num
Workbooks("QA Template.xls").SaveAs Filename:=myPath & "\" & Employee(k)
& ".xls"
Next k

Les, if this is where you are getting the error, then be sure that your
workbook name, including the file extension is correct. You mentioned that
you are working in xl07 and saving as xl97 - xl03. If so, your QA Template
file could have .xlsx or .xlsm file extension which would throw the error.





"WLMPilot" wrote in message
...
The workbooks and macros used are being created in Excel 2007, but saved
in the
97-2003 format.

I have a macro that the boss will use to enter employees and place the
names, date added, and count (sequential) into a worksheet. It loops in
case
there is more than one name to be added.

NOTE: The boss will be in workbook(QA Master.xls)

Once the boss is through entering names, the macro will then loop and
create
a workbook, copying the Workbook("QA Template.xls") and renaming it with
the
employee name that was entered.

I don't know why, but I am getting the following error on the line that
copies and names the new workbook:
Runtime Error 9
Subscript Out of Range

The macro is below:

Option Base 1
'Add Employee to list and create workbook for employee
Private Sub CommandButton2_Click()
Dim Employee(1 To 200), Msg, Title As String 'Array may not reach 200
entries
Dim Config, num, k As Integer
Dim Ans1, Ans2, cnt As Integer
Dim rng As Range
num = 1 'Tracks number of employees entered. Becomes actual UBound of
array
myPath = ThisWorkbook.Path
ADDEMP:
Employee(num) = InputBox("Enter Employee's Name (First or Middle, Last
Name)", "ADD EMPLOYEE")
If Employee(num) = "" Or Left(Employee(num), 1) = " " Then
MsgBox ("Invalid Entry. Please enter employee's name.")
Employee(num) = ""
GoTo ADDEMP
End If
Msg = "Is the employee's name correctly entered?"
Msg = Msg & vbNewLine & vbNewLine
Msg = Msg & Employee(num)
Config = vbYesNo + vbQuestion
Title = "VERIFY ENTRY"
Ans1 = MsgBox(Msg, Config, Title)
If Ans1 = vbNo Then
Employee(num) = ""
GoTo ADDEMP
End If
'Validation of Entry Complete
'Proceed to place data in cells
Set rng = Range("I65536").End(xlUp).Offset(1, 0)
rng.Select
rng.Value = Employee(num)
rng.Offset(0, -1).Value = Date 'Place DATE employee added into cell
If rng.Offset(-1, -2).Value = "NUM" Then 'Determine if this is first
line
in list
cnt = 1 'If YES, cnt = 1
Else
cnt = rng.Offset(-1, -2).Value 'Pick up last number entered (total
employees to date)
cnt = cnt + 1 'Add one to last count in employee list
End If
rng.Offset(0, -2).Value = cnt 'cnt serves as a count on number of
employees
in list.
Msg = "Do you want to enter another employee?"
Config = vbYesNo + vbQuestion
Title = "CONTINUE"
Ans2 = MsgBox(Msg, Config, Title)
If Ans2 = vbYes Then
num = num + 1
GoTo ADDEMP
End If
'Create workbook for each employee entered
For k = 1 To num
Workbooks("QA Template.xls").SaveAs Filename:=myPath & "\" & Employee(k)
& ".xls"
Next k
End Sub

I appreciate any help with this.

Les

Well, back to square one. I have made a couple of changes:

1) Changed SaveAs to SaveCopyAs
2) Removed the need of an array by creating the workbook for the employee
at the point the name is placed in the spreadsheet.

Workbook("QA Template.xls") does have the file ext .xls. It is in the same
directory as the QA Master.xls workbook which is where mypath gets the path.

FYI...The explanation previously given that sts the error may have been
caused because of the SaveAs renaming the template workbook apparently was
not true in this case. The QA Template workbook was never renamed on the
first pass of the loop.

Here is the section of the macro that contains the SaveCopyAs code now so
you can see the new placement:

End If
rng.Offset(0, -2).Value = cnt 'cnt serves as a count on number of employees
in list.
'Create workbook for each employee entered
Workbooks("QA Template.xls").SaveCopyAs Filename:=myPath & "\" & Employee &
".xls"
Msg = "Do you want to enter another employee?"

Thanks for your efforts. I await other options.

Les


"JLGWhiz" wrote:

For k = 1 To num
Workbooks("QA Template.xls").SaveAs Filename:=myPath & "\" & Employee(k)
& ".xls"
Next k

Les, if this is where you are getting the error, then be sure that your
workbook name, including the file extension is correct. You mentioned that
you are working in xl07 and saving as xl97 - xl03. If so, your QA Template
file could have .xlsx or .xlsm file extension which would throw the error.





"WLMPilot" wrote in message
...
The workbooks and macros used are being created in Excel 2007, but saved
in the
97-2003 format.

I have a macro that the boss will use to enter employees and place the
names, date added, and count (sequential) into a worksheet. It loops in
case
there is more than one name to be added.

NOTE: The boss will be in workbook(QA Master.xls)

Once the boss is through entering names, the macro will then loop and
create
a workbook, copying the Workbook("QA Template.xls") and renaming it with
the
employee name that was entered.

I don't know why, but I am getting the following error on the line that
copies and names the new workbook:
Runtime Error 9
Subscript Out of Range

The macro is below:

Option Base 1
'Add Employee to list and create workbook for employee
Private Sub CommandButton2_Click()
Dim Employee(1 To 200), Msg, Title As String 'Array may not reach 200
entries
Dim Config, num, k As Integer
Dim Ans1, Ans2, cnt As Integer
Dim rng As Range
num = 1 'Tracks number of employees entered. Becomes actual UBound of
array
myPath = ThisWorkbook.Path
ADDEMP:
Employee(num) = InputBox("Enter Employee's Name (First or Middle, Last
Name)", "ADD EMPLOYEE")
If Employee(num) = "" Or Left(Employee(num), 1) = " " Then
MsgBox ("Invalid Entry. Please enter employee's name.")
Employee(num) = ""
GoTo ADDEMP
End If
Msg = "Is the employee's name correctly entered?"
Msg = Msg & vbNewLine & vbNewLine
Msg = Msg & Employee(num)
Config = vbYesNo + vbQuestion
Title = "VERIFY ENTRY"
Ans1 = MsgBox(Msg, Config, Title)
If Ans1 = vbNo Then
Employee(num) = ""
GoTo ADDEMP
End If
'Validation of Entry Complete
'Proceed to place data in cells
Set rng = Range("I65536").End(xlUp).Offset(1, 0)
rng.Select
rng.Value = Employee(num)
rng.Offset(0, -1).Value = Date 'Place DATE employee added into cell
If rng.Offset(-1, -2).Value = "NUM" Then 'Determine if this is first
line
in list
cnt = 1 'If YES, cnt = 1
Else
cnt = rng.Offset(-1, -2).Value 'Pick up last number entered (total
employees to date)
cnt = cnt + 1 'Add one to last count in employee list
End If
rng.Offset(0, -2).Value = cnt 'cnt serves as a count on number of
employees
in list.
Msg = "Do you want to enter another employee?"
Config = vbYesNo + vbQuestion
Title = "CONTINUE"
Ans2 = MsgBox(Msg, Config, Title)
If Ans2 = vbYes Then
num = num + 1
GoTo ADDEMP
End If
'Create workbook for each employee entered
For k = 1 To num
Workbooks("QA Template.xls").SaveAs Filename:=myPath & "\" & Employee(k)
& ".xls"
Next k
End Sub

I appreciate any help with this.

Les


.

Well, I worked up this little test case and it seemed to work OK.

Option Base 1
Sub multWB()
Dim i As Long, myPath As String, myNames
myPath = ThisWorkbook.Path
myNames = Array("Joe", "George", "Ralph")
For i = 1 To UBound(myNames)
Workbooks("TestBook.xls").SaveCopyAs _
Filename:=myPath & "\" & myNames(i) & ".xls"
Next
End Sub


Chip pointed out something that I overlooked in my earlier post, and that is
that using just SaveAs will change the name of the active workbook and
effectively closes the original workbook that was copied. But using the
SaveCopyAS method leaves the original workbook intact and saves the new
workbooks as a closed file. The setup above captures the essence of what
your code did to build the array of names, using option base 1, so that when
the For ... Next loop runs, it is using the same parameters that your code
was using and it worked. I don't know if it was a typo when you made the
last post, but in this:

Workbooks("QA Template.xls").SaveCopyAs Filename:=myPath & "\" & Employee &
".xls"

the (x) is missing from Employee, to indicate which item of the array. Your
actual code probably has it included, but if it doesn't that would keep it
from working.



"WLMPilot" wrote in message
...
Well, back to square one. I have made a couple of changes:

1) Changed SaveAs to SaveCopyAs
2) Removed the need of an array by creating the workbook for the employee
at the point the name is placed in the spreadsheet.

Workbook("QA Template.xls") does have the file ext .xls. It is in the
same
directory as the QA Master.xls workbook which is where mypath gets the
path.

FYI...The explanation previously given that sts the error may have been
caused because of the SaveAs renaming the template workbook apparently was
not true in this case. The QA Template workbook was never renamed on the
first pass of the loop.

Here is the section of the macro that contains the SaveCopyAs code now so
you can see the new placement:

End If
rng.Offset(0, -2).Value = cnt 'cnt serves as a count on number of
employees
in list.
'Create workbook for each employee entered
Workbooks("QA Template.xls").SaveCopyAs Filename:=myPath & "\" & Employee
&
".xls"
Msg = "Do you want to enter another employee?"

Thanks for your efforts. I await other options.

Les


"JLGWhiz" wrote:

For k = 1 To num
Workbooks("QA Template.xls").SaveAs Filename:=myPath & "\" &
Employee(k)
& ".xls"
Next k

Les, if this is where you are getting the error, then be sure that your
workbook name, including the file extension is correct. You mentioned
that
you are working in xl07 and saving as xl97 - xl03. If so, your QA
Template
file could have .xlsx or .xlsm file extension which would throw the
error.





"WLMPilot" wrote in message
...
The workbooks and macros used are being created in Excel 2007, but
saved
in the
97-2003 format.

I have a macro that the boss will use to enter employees and place the
names, date added, and count (sequential) into a worksheet. It loops
in
case
there is more than one name to be added.

NOTE: The boss will be in workbook(QA Master.xls)

Once the boss is through entering names, the macro will then loop and
create
a workbook, copying the Workbook("QA Template.xls") and renaming it
with
the
employee name that was entered.

I don't know why, but I am getting the following error on the line that
copies and names the new workbook:
Runtime Error 9
Subscript Out of Range

The macro is below:

Option Base 1
'Add Employee to list and create workbook for employee
Private Sub CommandButton2_Click()
Dim Employee(1 To 200), Msg, Title As String 'Array may not reach 200
entries
Dim Config, num, k As Integer
Dim Ans1, Ans2, cnt As Integer
Dim rng As Range
num = 1 'Tracks number of employees entered. Becomes actual UBound of
array
myPath = ThisWorkbook.Path
ADDEMP:
Employee(num) = InputBox("Enter Employee's Name (First or Middle, Last
Name)", "ADD EMPLOYEE")
If Employee(num) = "" Or Left(Employee(num), 1) = " " Then
MsgBox ("Invalid Entry. Please enter employee's name.")
Employee(num) = ""
GoTo ADDEMP
End If
Msg = "Is the employee's name correctly entered?"
Msg = Msg & vbNewLine & vbNewLine
Msg = Msg & Employee(num)
Config = vbYesNo + vbQuestion
Title = "VERIFY ENTRY"
Ans1 = MsgBox(Msg, Config, Title)
If Ans1 = vbNo Then
Employee(num) = ""
GoTo ADDEMP
End If
'Validation of Entry Complete
'Proceed to place data in cells
Set rng = Range("I65536").End(xlUp).Offset(1, 0)
rng.Select
rng.Value = Employee(num)
rng.Offset(0, -1).Value = Date 'Place DATE employee added into cell
If rng.Offset(-1, -2).Value = "NUM" Then 'Determine if this is first
line
in list
cnt = 1 'If YES, cnt = 1
Else
cnt = rng.Offset(-1, -2).Value 'Pick up last number entered (total
employees to date)
cnt = cnt + 1 'Add one to last count in employee list
End If
rng.Offset(0, -2).Value = cnt 'cnt serves as a count on number of
employees
in list.
Msg = "Do you want to enter another employee?"
Config = vbYesNo + vbQuestion
Title = "CONTINUE"
Ans2 = MsgBox(Msg, Config, Title)
If Ans2 = vbYes Then
num = num + 1
GoTo ADDEMP
End If
'Create workbook for each employee entered
For k = 1 To num
Workbooks("QA Template.xls").SaveAs Filename:=myPath & "\" &
Employee(k)
& ".xls"
Next k
End Sub

I appreciate any help with this.

Les


.

Oops! In my last post, I failed to mention one important item. I am still
getting the same error.

As I indicated, I removed the neccessity for an array by moving the
SaveCopyAs line to the section in the code just prior to asking if another
name needs to be entered. This way, everything that needs to be done with an
employee's name is done prior to either exiting or looping back to get
another name.

Here is the section that holds the code as it currently is:

Here is the section of the macro that contains the SaveCopyAs code now so
you can see the new placement:

End If
rng.Offset(0, -2).Value = cnt 'cnt serves as a count on number of employees
in list.
'Create workbook for each employee entered
Workbooks("QA Template.xls").SaveCopyAs Filename:=myPath & "\" & Employee &
".xls"
Msg = "Do you want to enter another employee?"

The error is indicated as occurring at the point of trying to copy and
rename the new workbook.

Les

"JLGWhiz" wrote:

Well, I worked up this little test case and it seemed to work OK.

Option Base 1
Sub multWB()
Dim i As Long, myPath As String, myNames
myPath = ThisWorkbook.Path
myNames = Array("Joe", "George", "Ralph")
For i = 1 To UBound(myNames)
Workbooks("TestBook.xls").SaveCopyAs _
Filename:=myPath & "\" & myNames(i) & ".xls"
Next
End Sub


Chip pointed out something that I overlooked in my earlier post, and that is
that using just SaveAs will change the name of the active workbook and
effectively closes the original workbook that was copied. But using the
SaveCopyAS method leaves the original workbook intact and saves the new
workbooks as a closed file. The setup above captures the essence of what
your code did to build the array of names, using option base 1, so that when
the For ... Next loop runs, it is using the same parameters that your code
was using and it worked. I don't know if it was a typo when you made the
last post, but in this:

Workbooks("QA Template.xls").SaveCopyAs Filename:=myPath & "\" & Employee &
".xls"

the (x) is missing from Employee, to indicate which item of the array. Your
actual code probably has it included, but if it doesn't that would keep it
from working.



"WLMPilot" wrote in message
...
Well, back to square one. I have made a couple of changes:

1) Changed SaveAs to SaveCopyAs
2) Removed the need of an array by creating the workbook for the employee
at the point the name is placed in the spreadsheet.

Workbook("QA Template.xls") does have the file ext .xls. It is in the
same
directory as the QA Master.xls workbook which is where mypath gets the
path.

FYI...The explanation previously given that sts the error may have been
caused because of the SaveAs renaming the template workbook apparently was
not true in this case. The QA Template workbook was never renamed on the
first pass of the loop.

Here is the section of the macro that contains the SaveCopyAs code now so
you can see the new placement:

End If
rng.Offset(0, -2).Value = cnt 'cnt serves as a count on number of
employees
in list.
'Create workbook for each employee entered
Workbooks("QA Template.xls").SaveCopyAs Filename:=myPath & "\" & Employee
&
".xls"
Msg = "Do you want to enter another employee?"

Thanks for your efforts. I await other options.

Les


"JLGWhiz" wrote:

For k = 1 To num
Workbooks("QA Template.xls").SaveAs Filename:=myPath & "\" &
Employee(k)
& ".xls"
Next k

Les, if this is where you are getting the error, then be sure that your
workbook name, including the file extension is correct. You mentioned
that
you are working in xl07 and saving as xl97 - xl03. If so, your QA
Template
file could have .xlsx or .xlsm file extension which would throw the
error.





"WLMPilot" wrote in message
...
The workbooks and macros used are being created in Excel 2007, but
saved
in the
97-2003 format.

I have a macro that the boss will use to enter employees and place the
names, date added, and count (sequential) into a worksheet. It loops
in
case
there is more than one name to be added.

NOTE: The boss will be in workbook(QA Master.xls)

Once the boss is through entering names, the macro will then loop and
create
a workbook, copying the Workbook("QA Template.xls") and renaming it
with
the
employee name that was entered.

I don't know why, but I am getting the following error on the line that
copies and names the new workbook:
Runtime Error 9
Subscript Out of Range

The macro is below:

Option Base 1
'Add Employee to list and create workbook for employee
Private Sub CommandButton2_Click()
Dim Employee(1 To 200), Msg, Title As String 'Array may not reach 200
entries
Dim Config, num, k As Integer
Dim Ans1, Ans2, cnt As Integer
Dim rng As Range
num = 1 'Tracks number of employees entered. Becomes actual UBound of
array
myPath = ThisWorkbook.Path
ADDEMP:
Employee(num) = InputBox("Enter Employee's Name (First or Middle, Last
Name)", "ADD EMPLOYEE")
If Employee(num) = "" Or Left(Employee(num), 1) = " " Then
MsgBox ("Invalid Entry. Please enter employee's name.")
Employee(num) = ""
GoTo ADDEMP
End If
Msg = "Is the employee's name correctly entered?"
Msg = Msg & vbNewLine & vbNewLine
Msg = Msg & Employee(num)
Config = vbYesNo + vbQuestion
Title = "VERIFY ENTRY"
Ans1 = MsgBox(Msg, Config, Title)
If Ans1 = vbNo Then
Employee(num) = ""
GoTo ADDEMP
End If
'Validation of Entry Complete
'Proceed to place data in cells
Set rng = Range("I65536").End(xlUp).Offset(1, 0)
rng.Select
rng.Value = Employee(num)
rng.Offset(0, -1).Value = Date 'Place DATE employee added into cell
If rng.Offset(-1, -2).Value = "NUM" Then 'Determine if this is first
line
in list
cnt = 1 'If YES, cnt = 1
Else
cnt = rng.Offset(-1, -2).Value 'Pick up last number entered (total
employees to date)
cnt = cnt + 1 'Add one to last count in employee list
End If
rng.Offset(0, -2).Value = cnt 'cnt serves as a count on number of
employees
in list.
Msg = "Do you want to enter another employee?"
Config = vbYesNo + vbQuestion
Title = "CONTINUE"
Ans2 = MsgBox(Msg, Config, Title)
If Ans2 = vbYes Then
num = num + 1
GoTo ADDEMP
End If
'Create workbook for each employee entered
For k = 1 To num
Workbooks("QA Template.xls").SaveAs Filename:=myPath & "\" &
Employee(k)
& ".xls"
Next k
End Sub

I appreciate any help with this.

Les


.



.

So now, in theory, you should be creating a single workbook for a single
name and then asking if there is a another name to process? Did you make
sure that your InputBox variable is "Employee" ? (without the quotes of
course.) If the variable Employee contains the right value and
Workbooks("QA Template.xls") is a valid workbook,. there should be no reason
why you would get an error. Why don't you post the complete code again as
currently written so I can see if there are any fuzzy hands in it?



"WLMPilot" wrote in message
...
Oops! In my last post, I failed to mention one important item. I am
still
getting the same error.

As I indicated, I removed the neccessity for an array by moving the
SaveCopyAs line to the section in the code just prior to asking if another
name needs to be entered. This way, everything that needs to be done with
an
employee's name is done prior to either exiting or looping back to get
another name.

Here is the section that holds the code as it currently is:

Here is the section of the macro that contains the SaveCopyAs code now so
you can see the new placement:

End If
rng.Offset(0, -2).Value = cnt 'cnt serves as a count on number of
employees
in list.
'Create workbook for each employee entered
Workbooks("QA Template.xls").SaveCopyAs Filename:=myPath & "\" & Employee
&
".xls"
Msg = "Do you want to enter another employee?"

The error is indicated as occurring at the point of trying to copy and
rename the new workbook.

Les

"JLGWhiz" wrote:

Well, I worked up this little test case and it seemed to work OK.

Option Base 1
Sub multWB()
Dim i As Long, myPath As String, myNames
myPath = ThisWorkbook.Path
myNames = Array("Joe", "George", "Ralph")
For i = 1 To UBound(myNames)
Workbooks("TestBook.xls").SaveCopyAs _
Filename:=myPath & "\" & myNames(i) & ".xls"
Next
End Sub


Chip pointed out something that I overlooked in my earlier post, and that
is
that using just SaveAs will change the name of the active workbook and
effectively closes the original workbook that was copied. But using the
SaveCopyAS method leaves the original workbook intact and saves the new
workbooks as a closed file. The setup above captures the essence of what
your code did to build the array of names, using option base 1, so that
when
the For ... Next loop runs, it is using the same parameters that your
code
was using and it worked. I don't know if it was a typo when you made the
last post, but in this:

Workbooks("QA Template.xls").SaveCopyAs Filename:=myPath & "\" & Employee
&
".xls"

the (x) is missing from Employee, to indicate which item of the array.
Your
actual code probably has it included, but if it doesn't that would keep
it
from working.



"WLMPilot" wrote in message
...
Well, back to square one. I have made a couple of changes:

1) Changed SaveAs to SaveCopyAs
2) Removed the need of an array by creating the workbook for the
employee
at the point the name is placed in the spreadsheet.

Workbook("QA Template.xls") does have the file ext .xls. It is in the
same
directory as the QA Master.xls workbook which is where mypath gets the
path.

FYI...The explanation previously given that sts the error may have been
caused because of the SaveAs renaming the template workbook apparently
was
not true in this case. The QA Template workbook was never renamed on
the
first pass of the loop.

Here is the section of the macro that contains the SaveCopyAs code now
so
you can see the new placement:

End If
rng.Offset(0, -2).Value = cnt 'cnt serves as a count on number of
employees
in list.
'Create workbook for each employee entered
Workbooks("QA Template.xls").SaveCopyAs Filename:=myPath & "\" &
Employee
&
".xls"
Msg = "Do you want to enter another employee?"

Thanks for your efforts. I await other options.

Les


"JLGWhiz" wrote:

For k = 1 To num
Workbooks("QA Template.xls").SaveAs Filename:=myPath & "\" &
Employee(k)
& ".xls"
Next k

Les, if this is where you are getting the error, then be sure that
your
workbook name, including the file extension is correct. You mentioned
that
you are working in xl07 and saving as xl97 - xl03. If so, your QA
Template
file could have .xlsx or .xlsm file extension which would throw the
error.





"WLMPilot" wrote in message
...
The workbooks and macros used are being created in Excel 2007, but
saved
in the
97-2003 format.

I have a macro that the boss will use to enter employees and place
the
names, date added, and count (sequential) into a worksheet. It
loops
in
case
there is more than one name to be added.

NOTE: The boss will be in workbook(QA Master.xls)

Once the boss is through entering names, the macro will then loop
and
create
a workbook, copying the Workbook("QA Template.xls") and renaming it
with
the
employee name that was entered.

I don't know why, but I am getting the following error on the line
that
copies and names the new workbook:
Runtime Error 9
Subscript Out of Range

The macro is below:

Option Base 1
'Add Employee to list and create workbook for employee
Private Sub CommandButton2_Click()
Dim Employee(1 To 200), Msg, Title As String 'Array may not reach
200
entries
Dim Config, num, k As Integer
Dim Ans1, Ans2, cnt As Integer
Dim rng As Range
num = 1 'Tracks number of employees entered. Becomes actual UBound
of
array
myPath = ThisWorkbook.Path
ADDEMP:
Employee(num) = InputBox("Enter Employee's Name (First or Middle,
Last
Name)", "ADD EMPLOYEE")
If Employee(num) = "" Or Left(Employee(num), 1) = " " Then
MsgBox ("Invalid Entry. Please enter employee's name.")
Employee(num) = ""
GoTo ADDEMP
End If
Msg = "Is the employee's name correctly entered?"
Msg = Msg & vbNewLine & vbNewLine
Msg = Msg & Employee(num)
Config = vbYesNo + vbQuestion
Title = "VERIFY ENTRY"
Ans1 = MsgBox(Msg, Config, Title)
If Ans1 = vbNo Then
Employee(num) = ""
GoTo ADDEMP
End If
'Validation of Entry Complete
'Proceed to place data in cells
Set rng = Range("I65536").End(xlUp).Offset(1, 0)
rng.Select
rng.Value = Employee(num)
rng.Offset(0, -1).Value = Date 'Place DATE employee added into cell
If rng.Offset(-1, -2).Value = "NUM" Then 'Determine if this is
first
line
in list
cnt = 1 'If YES, cnt = 1
Else
cnt = rng.Offset(-1, -2).Value 'Pick up last number entered
(total
employees to date)
cnt = cnt + 1 'Add one to last count in employee list
End If
rng.Offset(0, -2).Value = cnt 'cnt serves as a count on number of
employees
in list.
Msg = "Do you want to enter another employee?"
Config = vbYesNo + vbQuestion
Title = "CONTINUE"
Ans2 = MsgBox(Msg, Config, Title)
If Ans2 = vbYes Then
num = num + 1
GoTo ADDEMP
End If
'Create workbook for each employee entered
For k = 1 To num
Workbooks("QA Template.xls").SaveAs Filename:=myPath & "\" &
Employee(k)
& ".xls"
Next k
End Sub

I appreciate any help with this.

Les


.



.

The problem is with the SaveAs code. You have

Workbooks("QA Template.xls").SaveAs Filename:=myPath & "\" &
Employee(k)

On the first iteration of the loop, the code will save "QA
Template.xls" under the new file name. After SaveAs, there is no
workbook named "QA Template.xls". The workbook that was initially
named "QA Tempalte.xls" is now named Employee(1), so on the second
iteration of the loop, the code will blow up when you attempt to
reference "QA Template.xls", since there is no longer a workbook with
that name.

A better way is to use SaveCopyAs rather than SaveAs. This will save
"QA Template.xls" to the new name, but leave the workbook named "QA
Template.xls" in place. With SaveCopyAs, the workbook is saved but is
not open in Excel after the save.

Cordially,
Chip Pearson
Microsoft MVP 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com
[email on web site]





On Tue, 11 May 2010 07:05:01 -0700, WLMPilot
wrote:

The workbooks and macros used are being created in Excel 2007, but saved in the
97-2003 format.

I have a macro that the boss will use to enter employees and place the
names, date added, and count (sequential) into a worksheet. It loops in case
there is more than one name to be added.

NOTE: The boss will be in workbook(QA Master.xls)

Once the boss is through entering names, the macro will then loop and create
a workbook, copying the Workbook("QA Template.xls") and renaming it with the
employee name that was entered.

I don't know why, but I am getting the following error on the line that
copies and names the new workbook:
Runtime Error 9
Subscript Out of Range

The macro is below:

Option Base 1
'Add Employee to list and create workbook for employee
Private Sub CommandButton2_Click()
Dim Employee(1 To 200), Msg, Title As String 'Array may not reach 200
entries
Dim Config, num, k As Integer
Dim Ans1, Ans2, cnt As Integer
Dim rng As Range
num = 1 'Tracks number of employees entered. Becomes actual UBound of array
myPath = ThisWorkbook.Path
ADDEMP:
Employee(num) = InputBox("Enter Employee's Name (First or Middle, Last
Name)", "ADD EMPLOYEE")
If Employee(num) = "" Or Left(Employee(num), 1) = " " Then
MsgBox ("Invalid Entry. Please enter employee's name.")
Employee(num) = ""
GoTo ADDEMP
End If
Msg = "Is the employee's name correctly entered?"
Msg = Msg & vbNewLine & vbNewLine
Msg = Msg & Employee(num)
Config = vbYesNo + vbQuestion
Title = "VERIFY ENTRY"
Ans1 = MsgBox(Msg, Config, Title)
If Ans1 = vbNo Then
Employee(num) = ""
GoTo ADDEMP
End If
'Validation of Entry Complete
'Proceed to place data in cells
Set rng = Range("I65536").End(xlUp).Offset(1, 0)
rng.Select
rng.Value = Employee(num)
rng.Offset(0, -1).Value = Date 'Place DATE employee added into cell
If rng.Offset(-1, -2).Value = "NUM" Then 'Determine if this is first line
in list
cnt = 1 'If YES, cnt = 1
Else
cnt = rng.Offset(-1, -2).Value 'Pick up last number entered (total
employees to date)
cnt = cnt + 1 'Add one to last count in employee list
End If
rng.Offset(0, -2).Value = cnt 'cnt serves as a count on number of employees
in list.
Msg = "Do you want to enter another employee?"
Config = vbYesNo + vbQuestion
Title = "CONTINUE"
Ans2 = MsgBox(Msg, Config, Title)
If Ans2 = vbYes Then
num = num + 1
GoTo ADDEMP
End If
'Create workbook for each employee entered
For k = 1 To num
Workbooks("QA Template.xls").SaveAs Filename:=myPath & "\" & Employee(k)
& ".xls"
Next k
End Sub

I appreciate any help with this.

Les