ExcelBanter - Error handling issue

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Error handling issue (https://www.excelbanter.com/excel-programming/401234-error-handling-issue.html)

Error handling issue

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

Error handling issue

Maybe

For a = 0 To (b - 11)-1 Step 1

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

wrote in message
...
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

Error handling issue

On 16 Nov, 17:11, "Bob Phillips" wrote:
Maybe

For a = 0 To (b - 11)-1 Step 1

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

wrote in message

...

Hi, I have created a timesheet system that is automated by buttons and
keep getting anerrormessage 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- Hide quoted text -

- Show quoted text -

Hi Bob,

Thank-you very much that did help me!

The only other problem that I am encountering no is this code:

Public Sub TemplateFormat()

Dim TimesheetRow, TemplateRow As Integer

Worksheets("Template").Activate

''ActiveSheet.Unprotect

TimesheetRow = Worksheets("New Time
Sheet").Range("A1:A300").Find(What:="Total for week").Row
TemplateRow =
Worksheets("Template").Range("A1:A300").Find(What: ="Total for
week").Row

''Rows.Count ("New Time Sheet!A12:L" & LastR)

'Row.xlDown

''''MsgBox Cells.Find(What:="Total for week").Address
'MsgBox "Template:" &
Worksheets("Template").Range("A1:A300").Find(What: ="Total for
week").Row & _
" Timesheet:" & Worksheets("New Time
Sheet").Range("A1:A300").Find(What:="Total for week").Row

If TimesheetRow TemplateRow Then

Worksheets("Template").Range(TemplateRow & ":" & TemplateRow -
(TimesheetRow - TemplateRow) + 1).Insert (xlShiftDown)
TemplateRow =
Worksheets("Template").Range("A1:A300").Find(What: ="Total for
week").Row

Worksheets("Template").Range("A13:N13").Copy

''Worksheets("Template").Range("A15:N" & (TemplateRow - 1)).Select
'' Selection.PasteSpecial xlPasteFormats

Worksheets("Template").Range("A12:N" & (TemplateRow - 1)).Select

Selection.PasteSpecial xlPasteFormats
Application.CutCopyMode = False

'SendKeys "{ESC}" = True
'SendKeys "{ESC}" = True

Worksheets("Template").Range("A1").Select

ElseIf TemplateRow TimesheetRow Then

b = TemplateRow - TimesheetRow - 1

Worksheets("Template").Range((TemplateRow - 1) - (b) & ":" &
TemplateRow - 1).Delete (xlShiftUp)

ElseIf TemplateRow = TimesheetRow Then

'ActiveSheet.Protect

End If

End Sub

Basically if I delete a number of rows and submit timesheet data, the
code works but when I add rows back into the "timesheet"and send the
data to the DB it seems to alter the "template" formats ,ie the font,
font size, line borders etc.., and shifts down rows inbetween the
standard Template Data (the top 11 rows that should not shift down)??

Thanks