N
neil_val
Hi, I have created a timesheet system that is automated by buttons and
keep getting an error message 9 - Subscript out of range. The
interesting thing is that it works depending on the what code I change
it to??
The code is trips on is:
rs("PROJECTCODE") = HoldingTableData(a, 1)
and I think it is to do with this part of the code
If b = 12 Then b = 13
For a = 1 To (b - 11) Step 1
and I can't seem to make it work without having to manually change the
code when it trips up.
I have copied the whole code down so that you can see what it is meant
to do, please any help would be so much appreciated.....
Thanks
Sub enterdatatask(week, HoldingTableData(), who)
Set cnn1 = CreateObject("ADODB.Connection")
openstr = "driver={Microsoft Access Driver (*.mdb)};" & _
"dbq=\\dsuk01\DO Administration$\DO Timesheets\Timesheets
\DO.mdb"
openstr = "driver={Microsoft Access Driver (*.mdb)};" & _
"dbq=" & DBFILE
'MsgBox cnn1
Set rs = CreateObject("ADODB.Recordset")
Sql = "SELECT HOLDINGTABLE.* FROM HOLDINGTABLE " & _
"WHERE (((HOLDINGTABLE.EMPLOYEESNAME)='" & who & "') AND
((HOLDINGTABLE.WKCOMDATE)= #" & Format(week, "mm/dd/yyyy") & "#));"
cnn1.Open openstr, "", ""
rs.Open Sql, cnn1, 2, 2, 1
If rs.EOF Then
Else
Do While Not rs.EOF
rs.Delete
rs.movefirst
Loop
End If
Worksheets("New Time Sheet").Activate
Dim b As Integer
For a = 12 To 100
If Range("A" & a) = "" Then
b = a - 1
Exit For
Else
End If
Next a
'Stop
If b = 12 Then b = 13
For a = 1 To (b - 11) Step 1
rs.addnew
rs("WKCOMDATE") = week
rs("PROJECTCODE") = HoldingTableData(a, 1)
rs("WORKCODE") = HoldingTableData(a, 2)
rs("MON") = HoldingTableData(a, 3)
rs("TUE") = HoldingTableData(a, 4)
rs("WED") = HoldingTableData(a, 5)
rs("THU") = HoldingTableData(a, 6)
rs("FRI") = HoldingTableData(a, 7)
rs("SAT") = HoldingTableData(a, 8)
rs("SUN") = HoldingTableData(a, 9)
rs("TOTALHRS") = HoldingTableData(a, 10)
rs("TASKCATEGORY") = HoldingTableData(a, 11)
rs("PARTNUMBER") = HoldingTableData(a, 12)
'''''rs("REPORTINGMONTH") = MonthName(Month(Date))
rs("EMPLOYEESNAME") = who
rs("DATESUBMITTED") = Date
'rs("DEPARTMENT") = dept
'rs("DATESUB") = Now()
Next a
rs.update
rs.Close
cnn1.Close
Set cnn1 = Nothing
Set rs = Nothing
'MsgBox (msg)
End Sub
'Function who()
'who = "Hello" 'Environ("username") '
'End Function
keep getting an error message 9 - Subscript out of range. The
interesting thing is that it works depending on the what code I change
it to??
The code is trips on is:
rs("PROJECTCODE") = HoldingTableData(a, 1)
and I think it is to do with this part of the code
If b = 12 Then b = 13
For a = 1 To (b - 11) Step 1
and I can't seem to make it work without having to manually change the
code when it trips up.
I have copied the whole code down so that you can see what it is meant
to do, please any help would be so much appreciated.....
Thanks
Sub enterdatatask(week, HoldingTableData(), who)
Set cnn1 = CreateObject("ADODB.Connection")
openstr = "driver={Microsoft Access Driver (*.mdb)};" & _
"dbq=\\dsuk01\DO Administration$\DO Timesheets\Timesheets
\DO.mdb"
openstr = "driver={Microsoft Access Driver (*.mdb)};" & _
"dbq=" & DBFILE
'MsgBox cnn1
Set rs = CreateObject("ADODB.Recordset")
Sql = "SELECT HOLDINGTABLE.* FROM HOLDINGTABLE " & _
"WHERE (((HOLDINGTABLE.EMPLOYEESNAME)='" & who & "') AND
((HOLDINGTABLE.WKCOMDATE)= #" & Format(week, "mm/dd/yyyy") & "#));"
cnn1.Open openstr, "", ""
rs.Open Sql, cnn1, 2, 2, 1
If rs.EOF Then
Else
Do While Not rs.EOF
rs.Delete
rs.movefirst
Loop
End If
Worksheets("New Time Sheet").Activate
Dim b As Integer
For a = 12 To 100
If Range("A" & a) = "" Then
b = a - 1
Exit For
Else
End If
Next a
'Stop
If b = 12 Then b = 13
For a = 1 To (b - 11) Step 1
rs.addnew
rs("WKCOMDATE") = week
rs("PROJECTCODE") = HoldingTableData(a, 1)
rs("WORKCODE") = HoldingTableData(a, 2)
rs("MON") = HoldingTableData(a, 3)
rs("TUE") = HoldingTableData(a, 4)
rs("WED") = HoldingTableData(a, 5)
rs("THU") = HoldingTableData(a, 6)
rs("FRI") = HoldingTableData(a, 7)
rs("SAT") = HoldingTableData(a, 8)
rs("SUN") = HoldingTableData(a, 9)
rs("TOTALHRS") = HoldingTableData(a, 10)
rs("TASKCATEGORY") = HoldingTableData(a, 11)
rs("PARTNUMBER") = HoldingTableData(a, 12)
'''''rs("REPORTINGMONTH") = MonthName(Month(Date))
rs("EMPLOYEESNAME") = who
rs("DATESUBMITTED") = Date
'rs("DEPARTMENT") = dept
'rs("DATESUB") = Now()
Next a
rs.update
rs.Close
cnn1.Close
Set cnn1 = Nothing
Set rs = Nothing
'MsgBox (msg)
End Sub
'Function who()
'who = "Hello" 'Environ("username") '
'End Function