Hi, I have been having all sorts of trouble with this timesheet system
problem that I have developed.I have been helped with solutions that
could have been the problem?? The problem I am encoutering is that
everytime someone submits their timesheet to the DB it misses out the
last row of data depending on how they have filled it out: ie if they
delete all the blank rows this particular code works:

If b = 12 Then b = 13

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

If they do not delete their blank rows this particular code works:

If b = 12 Then b = 13

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

I have a code that I think is the problem and I have no idea on how
arrays or even invert arrays work - here is the code:

Dim TaskData() As Variant

Call LastRow

TaskData() = Sheets("New Time Sheet").Range("A12:L" & LastR).Value

'TaskData() = Sheets("New Time Sheet").Range("A12:L12").Value

Dim Tempdata() As Variant

c = 0
For a = 1 To (LastR - 11) Step 1
'For a = 1 To 21 Step 1
'If TaskData(a, 11) = "" Then
If TaskData(a, 12) = "" Then


Else
c = c + 1
ReDim Preserve Tempdata(12, c)
''For d = 1 To (LastR - 11) Step 1
For d = 1 To 12 Step 1
Tempdata(d, c) = TaskData(a, d)
Next d
End If
Next a

'-----invert array-----

ReDim TaskData(c, 12)
For a = 1 To c Step 1
For b = 1 To 12 Step 1
TaskData(a, b) = Tempdata(b, a)
Next b
Next a


I have also copied the whole sub (module) for reference:

Dim DBFILE As String
Dim who As String
Dim dept As String

'Const DBFILE As String = "U:\Db\db1.mdb"

Sub Adddata()

'Dim DBFILE, who As String
'DBFILE = "U:\Db\db1.mdb"
DBFILE = Sheets("Setup").Range("B6").Value

sheetdate = Str$(Cells(1, 11))
who = Environ("username")

'''Call validate("New Time Sheet", sheetdate) 'Validate Data

Dim timein(1 To 7) As Variant
Dim timeout(1 To 7) As Variant
Dim timelunch(1 To 7) As Variant
Dim weekhours As Single
Dim week As Date

week = Sheets("New Time Sheet").Range("K1")

weekhours = 0
For a = 1 To 7 Step 1
timein(a) = Sheets("New Time Sheet").Cells(5, a + 2)
timelunch(a) = Sheets("New Time Sheet").Cells(6, a + 2)
timeout(a) = Sheets("New Time Sheet").Cells(7, a + 2)
weekhours = weekhours + (timeout(a) - timein(a) - timelunch(a)) *
24
Next a

Dim TaskData() As Variant

Call LastRow

TaskData() = Sheets("New Time Sheet").Range("A12:L" & LastR).Value

'TaskData() = Sheets("New Time Sheet").Range("A12:L12").Value

Dim Tempdata() As Variant

c = 0
For a = 1 To (LastR - 11) Step 1
'For a = 1 To 21 Step 1
'If TaskData(a, 11) = "" Then
If TaskData(a, 12) = "" Then


Else
c = c + 1
ReDim Preserve Tempdata(12, c)
''For d = 1 To (LastR - 11) Step 1
For d = 1 To 12 Step 1
Tempdata(d, c) = TaskData(a, d)
Next d
End If
Next a

'-----invert array-----

ReDim TaskData(c, 12)
For a = 1 To c Step 1
For b = 1 To 12 Step 1
TaskData(a, b) = Tempdata(b, a)
Next b
Next a

'----------Check to see if data exists-------------

msg = Null

Set cnn1 = CreateObject("ADODB.Connection")
openstr = "driver={Microsoft Access Driver (*.mdb)};" & _
"dbq=" & DBFILE

Set rs = CreateObject("ADODB.Recordset")

Sql = "SELECT Sum([HoldingTable].[TotalHrs]) AS TOTAL, [HoldingTable].
[EmployeesName], [HoldingTable].[WkComDate], [HoldingTable].
[Department] " & _
"FROM [HoldingTable] " & _
"GROUP BY [HoldingTable].[EmployeesName], [HoldingTable].[WkComDate],
[HoldingTable].[Department] " & _
"HAVING [HoldingTable].[EmployeesName]='" & who & "';"
'"HAVING ((([Holding Table].[EmployeeName])='" & who & "') AND
((HoldingTable.DATE)=#" & Format(week, "mm/dd/yyyy") & "#));"

On Error GoTo error1

cnn1.Open openstr, "", ""
rs.Open Sql, cnn1, 2, 2, 1

On Error GoTo 0

err = 0



If rs.RecordCount < -1 Then
If rs!WkComDate < week Then
err = 0
Else
msg = msg & "Data already exists for this period" & Chr(13) &
Chr(13)
Do While Not rs.EOF
msg = msg & Format(rs("Total"), "0.0") & " Hours Submitted
Already" & vbCrLf
rs.movenext
Loop
err = 1
End If

rs.Close
cnn1.Close
Set cnn1 = Nothing
Set rs = Nothing
msg = msg & Chr(13) & Chr(13) & "Overwrite existing data?"

If err = 1 Then err = MsgBox(msg, vbYesNo)

Else

If err = 7 Then
MsgBox ("Submission aborted")
End
Else
Call enterdatatimeinout(week, timein(), timeout(), timelunch(),
who)
Call enterdatatask(week, TaskData(), who)
msg = weekhours & " - Hours Submitted into Database"
MsgBox (msg)
End If
End If

''''End

Exit Sub

error1:

MsgBox ("Error: Please check the location of the Database")
Stop

End Sub

Sub enterdatatimeinout(week, timein(), timeout(), timelunch(), who)

Set cnn1 = CreateObject("ADODB.Connection")

openstr = "driver={Microsoft Access Driver (*.mdb)};" & _
"dbq=" & DBFILE

'openstr = "driver={Microsoft Access Driver (*.mdb)};" & _
"dbq=U:\db\db1.mdb"

Set rs = CreateObject("ADODB.Recordset")

Sql = "SELECT TIMEINOUT.* FROM TIMEINOUT " & _
"WHERE (((TIMEINOUT.EMPLOYEESNAME)='" & who & "') AND
((TIMEINOUT.DATE)= #" & Format(week, "mm/dd/yyyy") & "# " & _
"AND (TIMEINOUT.DATE)<= #" & Format((week + 6), "mm/dd/yyyy") &
"#)); "

'MsgBox (Sql)

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

For a = 1 To 7 Step 1
rs.addnew
rs("DATE") = week + a - 1
rs("TIMEIN") = timein(a)
rs("TIMELUNCH") = timelunch(a)
rs("TIMEOUT") = timeout(a)
rs("EMPLOYEESNAME") = who
'rs("DEPARTMENT") = dept
rs("DATESUBMITTED") = Now()
Next a
rs.update

rs.Close
cnn1.Close
Set cnn1 = Nothing
Set rs = Nothing

'MsgBox (msg)

End Sub

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 (a - 11) - 1 Step 1

'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

Please, please, please, any help will be soooo much appreciated.
Thanks

Hi

When you are assigning data to your array the first field in the array will
have index number 0.

If you want to make first index = 1 put this line at the top of your code
(outside the sub):

Option Base 1

Regards,

Per


I have a code that I think is the problem and I have no idea on how
arrays or even invert arrays work - here is the code:

Dim TaskData() As Variant

Call LastRow

TaskData() = Sheets("New Time Sheet").Range("A12:L" & LastR).Value

'TaskData() = Sheets("New Time Sheet").Range("A12:L12").Value

Dim Tempdata() As Variant

c = 0
For a = 1 To (LastR - 11) Step 1
'For a = 1 To 21 Step 1
'If TaskData(a, 11) = "" Then
If TaskData(a, 12) = "" Then


Else
c = c + 1
ReDim Preserve Tempdata(12, c)
''For d = 1 To (LastR - 11) Step 1
For d = 1 To 12 Step 1
Tempdata(d, c) = TaskData(a, d)
Next d
End If
Next a

'-----invert array-----

ReDim TaskData(c, 12)
For a = 1 To c Step 1
For b = 1 To 12 Step 1
TaskData(a, b) = Tempdata(b, a)
Next b
Next a

On 4 Dec, 16:41, "Per Jessen" wrote:
Hi

When you are assigning data to your array the first field in the array will
have index number 0.

If you want to make first index = 1 put this line at the top of your code
(outside the sub):

Option Base 1

Regards,

Per





I have a code that I think is the problem and I have no idea on how
arrays or even invert arrays work - here is the code:

Dim TaskData() As Variant

Call LastRow

TaskData() = Sheets("New Time Sheet").Range("A12:L" & LastR).Value

'TaskData() = Sheets("New Time Sheet").Range("A12:L12").Value

Dim Tempdata() As Variant

c = 0
For a = 1 To (LastR - 11) Step 1
'For a = 1 To 21 Step 1
'If TaskData(a, 11) = "" Then
If TaskData(a, 12) = "" Then

Else
c = c + 1
ReDim Preserve Tempdata(12, c)
''For d = 1 To (LastR - 11) Step 1
For d = 1 To 12 Step 1
Tempdata(d, c) = TaskData(a, d)
Next d
End If
Next a

'-----invert array-----

ReDim TaskData(c, 12)
For a = 1 To c Step 1
For b = 1 To 12 Step 1
TaskData(a, b) = Tempdata(b, a)
Next b
Next a- Hide quoted text -

- Show quoted text -

Hi I have entered the code outside of the Sub and when I run it I get
Error 9 Subscript out of range??

Thanks