My access form keeps on updating same row in excel 2003

[bsunuwar]

HI everybody,


I am having difficulty in finding out the problem because I know nothing about access Visual Basic so please help me.The problem is my access 2003 form only updates same cell or row in excel spreadsheet instead of moving to the next row when I press update for second time.IT worked perfectly for more than 6 months and now its making me sick please see my code below :-



Option Compare Database

Private Sub cmdConsolidate_Click()

Dim db, strsql, rs, intRecCount, qry2, intChqNo, confirm

confirm = MsgBox("Are you sure you wish to consolidate cheques? You will NOT be able to re-print cheques OR remittance advice slips after!", vbYesNo, "Confirm")

If confirm = 6 Then

Set db = CurrentDb()
strsql = "SELECT cheques.* FROM cheques WHERE (((cheques.printed) = False)) ORDER BY cheques.pk"
Set rs = db.OpenRecordset(strsql, dbOpenDynaset, dbSeeChanges)

If rs.EOF Then
MsgBox "There are no cheques to be consolidated"
Else
rs.MoveLast
intRecCount = rs.RecordCount
rs.MoveFirst

For i = 1 To intRecCount
Set qry2 = db.QueryDefs("qGeneric")
strsql = "UPDATE cheques SET printed=1 WHERE pk=" & CStr(rs("pk"))
qry2.SQL = strsql

db.Execute "qGeneric", dbSeeChanges
rs.MoveNext
Next

MsgBox "Consolidation complete"
DoCmd.Close acForm, "printmenu"

End If
End If

End Sub

Private Sub Command16_Click()

Dim xl
'Dim opendialog As New MSComDlg.CommonDialog
Dim i
Dim i2
Dim cell
Dim rowtouse
Dim qry
Dim rs
Dim intRecCount
Dim db As Database

Set db = CurrentDb()

'opendialog.Filter = "xls"
'opendialog.Filename = "*.xls"
'opendialog.ShowOpen

Set xl = CreateObject("Excel.Application")
'xl.Workbooks.Open (opendialog.File)
xl.Workbooks.Open ("\\chirpsv1\Finance\Management Accounts\Accounts 01.04.09-31.03.10.xls")
xl.Sheets("Cheques Written").Select

For i = 3 To 16000
cell = "C" + CStr(i)
If xl.Range(cell).Value = "" Then
rowtouse = i
i = 15999
End If
i = i + 1
Next

Set qry = db.QueryDefs("ChequestoPrint")
Set rs = qry.OpenRecordset(dbOpenDynaset, dbSeeChanges)
rs.MoveLast
intRecCount = rs.RecordCount
rs.MoveFirst

For i2 = 1 To intRecCount

Dim supplier
Dim dateofcheque
Dim chequenumber
Dim details
Dim amount

supplier = Trim(rs("Name"))
dateofcheque = Replace(Trim(rs("dateprinted") & ""), "/", ".")
chequenumber = Trim(rs("chqno"))
details = Trim(rs("description"))
amount = Trim(rs("totalpayable"))

datemonth = Mid(dateofcheque, 8, 4)
dateday = Mid(dateofcheque, 2, 4)
dateyear = Mid(dateofcheque, 10, 4)

dateofcheque = dateday + "." + datemonth + "." + dateyear

xl.Range("A" + CStr(rowtouse)).Value = supplier
xl.Range("B" + CStr(rowtouse)).Value = dateofcheque
xl.Range("C" + CStr(rowtouse)).Value = chequenumber
xl.Range("D" + CStr(rowtouse)).Value = details
xl.Range("E" + CStr(rowtouse)).Value = amount

rowtouse = rowtouse + 1

rs.MoveNext

Next


xl.Visible = True

Set xl = Nothing




End Sub

Private Sub Command2_Click()

Dim confirm, db, qry, qry2, rs, rs2, intRecCount, intChqNo, strsql, strSignedBy

confirm = MsgBox("Are you sure you wish to print the cheques now?", vbYesNo, "Confirm")

If confirm = 6 Then
strFirstChqNo = Me![txtFirstChqNo]

If IsNull(strFirstChqNo) = False Then
Set db = CurrentDb()

strsql = "SELECT cheques.* FROM cheques WHERE (((cheques.printed) = False)) ORDER BY cheques.pk"
Set rs = db.OpenRecordset(strsql, dbOpenDynaset, dbSeeChanges)

If rs.EOF Then
MsgBox "There are no cheques to be printed"
Else
rs.MoveLast
intRecCount = rs.RecordCount
rs.MoveFirst

intChqNo = CDbl(Me![txtFirstChqNo])
strSignedBy = CStr(Me![txtSignedBy])

For i = 1 To intRecCount
Set qry2 = db.QueryDefs("qGeneric")
strsql = "UPDATE cheques SET signedby='" & CStr(strSignedBy) & "' WHERE pk=" & CStr(rs("pk"))
qry2.SQL = strsql

db.Execute "qGeneric", dbSeeChanges

intChqNo = intChqNo + 1
rs.MoveNext
Next
rs.MoveFirst

DoCmd.OpenReport "rptChqReq", acViewPreview
intChqNo = CDbl(Me![txtFirstChqNo])

For i = 1 To intRecCount
Set qry3 = db.QueryDefs("qGeneric")
strsql = "UPDATE cheques SET chqno='" & CStr(intChqNo) & "', dateprinted=DATE() WHERE pk=" & CStr(rs("pk"))
qry3.SQL = strsql

db.Execute "qGeneric", dbSeeChanges

intChqNo = intChqNo + 1
rs.MoveNext
Next
End If
Else
MsgBox "You must enter the first cheque number to proceed", vbOKOnly, "Error"
End If
Else
MsgBox "Printing cancelled", vbOKOnly, "Cancelled"
End If

End Sub

Private Sub Command3_Click()

DoCmd.OpenReport "rptChqReqTest", acViewPreview

End Sub
Private Sub cmdPrintRemit_Click()
On Error GoTo Err_cmdPrintRemit_Click

Dim stDocName As String

stDocName = "rptRemitAdvice"
DoCmd.OpenReport stDocName, acPreview

Exit_cmdPrintRemit_Click:
Exit Sub

Err_cmdPrintRemit_Click:
MsgBox Err.description
Resume Exit_cmdPrintRemit_Click

End Sub
Private Sub cmdExit_Click()
On Error GoTo Err_cmdExit_Click

DoCmd.Close

Exit_cmdExit_Click:
Exit Sub

Err_cmdExit_Click:
MsgBox Err.description
Resume Exit_cmdExit_Click

End Sub

 

[zelgar]

I'm no expert, but it looks like the macro is looking for the first blank cell in Col C in cells 3 to 1600 to determine where to put the data (i.e., rowtouse).

Later, you're putting data from the access database into the excel file using the rowtouse location. I'd check the following lines to verify that you're getting the right information to put in Col C of the spreadsheet:

chequenumber = Trim(rs("chqno"))
xl.Range("C" + CStr(rowtouse)).Value = chequenumber

I'd check the database/put a pause in the macro to check these lines to make certain you're not putting a blank cell in C (rowtouse).

 

[brengine]

What Row number does it keep using...15999, 16000?

Just quickly looking...
For this portion:

If xl.Range(cell).Value = "" Then
rowtouse = i
i = 15999
End If

Shouldn't it be i = 16000, or even better 'Exit For'?

 

[zelgar]

I think the reason why i is defined as 15999 is that right after the End if, i=i+1 making i = 16000.