W
WLMPilot
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
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