Running sum in vba, ms access - ms-access

I'm trying to update one field (tblUSA.RunSum) with the running sum of another field (Length), starting at tblUSA.RunSum= 0 for the first value. So far, I'm having no luck. Mo updates tblUSA are writing.
Dim db As Database
Set db = CurrentDb()
Dim lastValue, thisValue
s = "tblUSA"
Set rs = db.OpenRecordset(s, dbOpenDynaset)
'rs.Sort ("DateS")
lastValue = rs.Fields("Length")
rs.MoveNext
While (Not rs.EOF())
thisValue = rs.Fields("Length")
rs.Edit
rs!RunSum = thisValue + lastValue
rs.Update
lastValue = thisValue ' remember previous value
rs.MoveNext ' advance to next record
Wend
MsgBox "Done with " & s

This might do:
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim lastValue As Double
Dim s As String
Set db = CurrentDb()
s = "Select * From tblUSA Order By DateS"
Set rs = db.OpenRecordset(s, dbOpenDynaset)
While Not rs.EOF
rs.Edit
rs!RunSum.Value = lastValue ' Initially = 0
rs.Update
lastValue = lastValue + rs.Fields("Length").Value
rs.MoveNext
Wend
rs.Close

Related

Error 3021: No Current Record when trying to edit a value in a column of a table through forms

I'm following this tutorial to create a add/subtract button that amends the 'Qty_Avail' value of a Stock table
https://www.youtube.com/watch?v=88erYOa8cmg
Private Sub cmdIN_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Set db = CurrentDb
Set rst = db.OpenRecordset("Select Qty_Avail from Stock where ID_Item =' " & Me.ID_Item & " ' ")
With rst
.Edit
!Qty_Avail = !Qty_Avail + Nz(Me.Quantity, 0)
.Update
End With
Me.QOH.Requery
Me.Quantity = "'"
End Sub
Try using the RecordsetClone - faster and updates at once:
Private Sub cmdIN_Click()
Dim rst As DAO.Recordset
Set rst = Me.RecordsetClone
With rst
' Locate current record.
.Bookmark = Me.Bookmark
' Edit the record.
.Edit
!Qty_Avail.Value = !Qty_Avail.Value + Nz(Me!Quantity.Value, 0)
.Update
.Close
End With
Me!Quantity.Value = 0 ' Or = Null
End Sub

Access Select IN using VBA function

So I have this SQL Query
SELECT *
FROM [Employee To Manager]
WHERE [Employee To Manager].[Manager UID] In(getMyTeamUserNames());
Which has a VBA function getMyTeamUserNames()
Public Function getMyTeamUserNames() As String
Dim rs As DAO.Recordset
Dim dbs As DAO.Database
Set dbs = CurrentDb
getMyTeamUserNames = commaDelimitArray(getTeamUserNames(getUserName, dbs))
End Function
Public Function commaDelimitArray(arrayStr) As String
Dim sepStr As String
sepStr = "','"
commaDelimitArray = "'" & Join(arrayStr, sepStr)
End Function
Public Function getTeamUserNames(username, dbs) As String()
Dim sqlstatement As String
sqlstatement = "SELECT * FROM [Employee to Manager] WHERE [Employee to
Manager].[Manager UID] = '" & username & "'"
Set rs = dbs.OpenRecordset(sqlstatement, dbOpenSnapshot)
Dim ComputerUsernames() As String
Dim FindRecordCount As Integer
If rs.EOF Then
FindRecordCount = 0
Exit Function
Else
rs.MoveLast
FindRecordCount = rs.RecordCount
End If
ReDim ComputerUsernames(FindRecordCount) As String
Dim i As Integer
i = 0
rs.MoveFirst
Do Until rs.EOF = True
ComputerUsernames(i) = rs("Computer Username")
If (ComputerUsernames(i) <> "") Then
i = i + 1
End If
If (ComputerUsernames(i - 1) <> username) Then
Dim recurResult() As String
recurResult = getTeamUserNames(ComputerUsernames(i - 1), dbs)
Dim resultSize As Integer
If Len(Join(recurResult)) > 0 Then
resultSize = UBound(recurResult) - LBound(recurResult) + 1
ReDim Preserve ComputerUsernames(UBound(ComputerUsernames) + resultSize)
For Each resultStr In recurResult
ComputerUsernames(i) = resultStr
If (ComputerUsernames(i) <> "") Then
i = i + 1
End If
Next resultStr
End If
End If
rs.MoveNext
Loop
ReDim Preserve ComputerUsernames(i - 1)
getTeamUserNames = ComputerUsernames
End Function
Query runs and I get no data.
However if I take the result from getMyTeamUserNames() and put it in the query by hand it works. getMyTeamUserNames() result varies from possibly 2 results to 40 (recursively gets subordinates all the way down the tree).
So a C Perkins specifically pointed out this would never work so I have rebuilt the query with some other queries.

How can i add parameter code to export a query from access 2013 to excel 2013

'Below is the current code that I have and it will export to the excel workbook and worksheet correctly. The only problem is that I need to limit the data that gets exported by a month end date range (example: 1/31/2017 to 4/30/2017) and also by a plant number (example: "4101") thanks for any help it is greatly appreciated.
Public Function InventoryXport_4100()
Dim appXL As Object
Dim wb As Object
Dim wks As Object
Dim xlf As String
Dim rs As DAO.Recordset
Dim fld As Field
Dim intColCount As Integer
xlf = "Z:\COST ACCOUNTING INFO\Inventory Reports\MyFile.xlsx"
Set rs = CurrentDb.OpenRecordset("(QS)_Inventory")
Set appXL = CreateObject("Excel.Application")
Set wb = appXL.Workbooks.Open(xlf)
Set wks = wb.Sheets("Inventory Xport") 'Sheet name
If rs.EOF = True Then
MsgBox "No data", vbOKOnly
Exit Function
End If
With appXL
.Application.worksheets("Inventory Xport").SELECT
.Application.columns("A:AQ").SELECT
.Application.columns.Clear
End With
intColCount = 1
For Each fld In rs.Fields
wks.Cells(1, intColCount).Value = fld.Name
intColCount = intColCount + 1
Next fld
appXL.displayalerts = False
wks.Range("A2").CopyFromRecordset rs
appXL.Visible = True
With appXL
.Application.worksheets("Inventory Xport").SELECT
.Application.columns("A:AQ").SELECT
.Application.columns.AutoFit
.Application.Range("A2").SELECT
.Application.ActiveWindow.FreezePanes = True
End With
wb.Save
wb.Close
appXL.Quit
Set wb = Nothing
rs.Close
Set rs = Nothing
End Function
You can use:
Dim Date1 As Date
Dim Date2 As Date
Dim PlantNr As String
Dim Sql As String
Date1 = #1/31/2017#
Date2 = #4/30/2017#
PlantNr = "4101"
Sql = "Select * From [(QS)_Inventory] Where YourDateField Between #" & Format(Date1, "yyyy\/mm\/dd") & "# And #" & Format(Date2, "yyyy\/mm\/dd") & "# And [Plant Number] = '" & PlantNr & "'"
Set rs = CurrentDb.OpenRecordset(Sql)

Query code generating Invalid Use Of Null

My code is generating an Invalid Use Of Null and I am not seeing the issue. When I compile the code, I do not get an error, but when I run and debug it, the error occurs at strRESMILE = rs("RESMILE").
Any thoughts? I can upload the database if need be.
Sub COMPARE()
On Error GoTo err_COMPARE
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strHold As String
Dim strRESMILE As String
Dim strRESMONTH As String
Dim dblMILEAGEHold As Double
Dim dblDATEHold As Double
Set db = CurrentDb
strSQL = "SELECT * FROM TABLE3"
Set rs = db.OpenRecordset(strSQL)
With rs
' If Not .BOF And Not .EOF Then
' .MoveLast
' .MoveFirst
If Not .BOF Then
strHold = rs("VIN")
dblMILEAGEHold = rs("MILES")
.Edit
rs("RESMILE") = ""
.Update
.MoveNext
'While (Not .EOF)
Do Until .EOF
.Edit
If rs("VIN") = strHold Then
'do comparison
If rs("MILEAGE") > rs("MILES") Then
rs("RESMILE") = "Y"
Else
rs("RESMILE") = "N"
End If
End If
.Update
strHold = rs("VIN")
strRESMILE = rs("RESMILE")
.MoveNext
' Wend
Loop
End If
End With
Set db = CurrentDb
strSQL = "SELECT * FROM TABLE3"
Set rs = db.OpenRecordset(strSQL)
With rs
If Not .BOF Then
strHold = rs("VIN")
dblDATEHold = rs("MONTHS")
.Edit
rs("RESMONTH") = ""
.Update
.MoveNext
Do Until .EOF
.Edit
If rs("VIN") = strHold Then
'do comparison
If rs("INSM") > rs("MONTHS") Then
rs("RESMONTH") = "Y"
Else
rs("RESMONTH") = "N"
End If
End If
.Update
strHold = rs("VIN")
dblDATEHold = rs("RESMONTH")
.MoveNext
Loop
End If
End With
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
MsgBox "Comparisons Completed!"
exit_COMPARE:
Exit Sub
err_COMPARE:
MsgBox Err.Description
Resume exit_COMPARE
End Sub
Handle the evident NULL in your [RESMILE] field by using Nz().
So change strRESMILE = rs("RESMILE") to strRESMILE = Nz(rs("RESMILE"))

DAO method in MS Access

I am unable to get the count of records by openining Ms Access Query, I use the following code.
Private Sub CmdGetData_Click()
Dim WRK As Workspace
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim StrSql As String
Set WRK = DBEngine.Workspaces(0)
Set db = CurrentDb
StrSql = "select * from [QrySalePatti]"
Set rs = db.OpenRecordset(StrSql, dbOpenDynaset)
Do While (Not rs.EOF)
rs.MoveFirst
rs.MoveLast
MsgBox rs.RecordCount
Loop
exitRoutine:
If Not (db Is Nothing) Then
db.Close
Set db = Nothing
End If
Set WRK = Nothing
End Sub
You should not need a Do While loop to get the RecordCount.
Set rs = db.OpenRecordset(StrSql, dbOpenDynaset)
With rs
If Not (.BOF And .EOF) Then
.MoveLast
End If
MsgBox .RecordCount
End With
However if your goal is only to count the rows from QrySalePatti, you could use a SELECT Count(*) query and read the value returned from that.
StrSql = "SELECT Count(*) AS row_count FROM [QrySalePatti]"
Set rs = db.OpenRecordset(StrSql)
MsgBox rs!row_count
Or you could use a DCount expression.
MsgBox DCount("*", "QrySalePatti")