I am trying to reset value of date to null and value of weight to null.
I tried the following code, but only weight is being set to 0 and date is not set to null:
Private Sub Form_Load()
Me.Text42.Value = ""
Dim i As Integer
Dim Db6 As Database
Dim Rs6 As Recordset
Dim Trn6 As String
Set Db6 = CurrentDb
Set Rs6 = Db6.OpenRecordset("GoatMasterTable")
Do While Not Rs6.EOF
If Rs6.Fields("Recentweight") > 0 Then
Rs6.Edit
Rs6.Fields("RecentWeight") = 0
Rs6.Fields("RecentWeightDate") = """" Or IsNull(Rs6!RecentWeightDate)
Rs6.Update
End If
Rs6.MoveNext
Loop
Rs6.Close
Set Rs6 = Nothing
Db6.Close
End Sub
Since you are not performing record-dependent calculations and are merely setting each record to the same value, an easier method would be to simply execute a SQL statement such as:
update GoatMasterTable set RecentWeight = 0, RecentWeightDate = Null where RecentWeight > 0
As such, your function might become:
Private Sub Form_Load()
Me.Text42 = ""
With CurrentDb
.Execute "update GoatMasterTable set RecentWeight = 0, RecentWeightDate = Null where RecentWeight > 0"
End With
End Sub
You will also need to ensure that the RecentWeightDate field in your GoatMasterTable allows null values.
All you need is to set the date field to Null:
Rs6.Fields("RecentWeight").Value = 0
Rs6.Fields("RecentWeightDate").Value = Null
Of course, field RecentWeightDate of the table must allow Null values.
Related
As the title says I have a form in access that I use for data entry. This form has to load 2 comboboxes one for suplier name the other for location name. The other thing it does is check if user has access to the form. This is on the load event.
Private Sub Form_Load()
'Verify User Access
If Globales.Accesos(Me.Name) = 0 Then
MsgBox "No tiene accesos a esta area."
DoCmd.Close acForm, Me.Name
End If
'Set Null Values
Me.Text14 = Null
Me.Text16 = Null
Me.Text18 = Null
Me.Combo26 = Null
Me.Text73 = Null
Me.Text28 = Null
Me.Text50 = Null
Me.Text42 = Null
Me.Text46 = Null
Me.Text44 = Null
Me.Text40 = Null
Me.Text48 = Null
Me.Text30 = Null
Me.Text36 = Null
Me.Text38 = Null
Me.Text52 = Null
Me.Text54 = Null
Me.Text75 = Null
'Set Combobox Localidades Values
Dim db2 As DAO.Database
Dim rs2 As DAO.Recordset
Dim SQL2 As String
Set db2 = OpenDatabase("", False, False, Globales.ConnString)
SQL2 = "SELECT tbl5localidades.ID, tbl5localidades.NombreLocalidad FROM tbl5localidades;"
Set rs2 = db2.OpenRecordset(SQL2, dbOpenDynaset, dbReadOnly)
With Text18
.RowSourceType = "Value List"
.BoundColumn = 1
.ColumnCount = 2
.ColumnWidths = "0;1in"
End With
With rs2
.MoveFirst
Do Until .EOF
Text18.AddItem !ID & ";" & !NombreLocalidad
.MoveNext
Loop
End With
rs2.Close
Set rs2 = Nothing
'db2.Close
'Set db2 = Nothing
'Set Combobox Suplidores Values
Dim db3 As DAO.Database
Dim rs3 As DAO.Recordset
Dim SQL3 As String
Set db3 = OpenDatabase("", False, False, Globales.ConnString)
SQL3 = "SELECT tbl6suplidores.ID, tbl6suplidores.NombreSuplidor FROM tbl6suplidores ORDER BY tbl6suplidores.NombreSuplidor;"
Set rs3 = db3.OpenRecordset(SQL3, dbOpenDynaset, dbReadOnly)
With Combo26
.RowSourceType = "Value List"
.BoundColumn = 1
.ColumnCount = 2
.ColumnWidths = "0;1in"
End With
With rs3
.MoveFirst
Do Until .EOF
Combo26.AddItem !ID & ";" & !NombreSuplidor
.MoveNext
Loop
End With
rs3.Close
Set rs3 = Nothing
'db3.Close
'Set db3 = Nothing
End Sub
This works as intended but its so slow that get Acces to be unresponsive for about 30sec. Is there anyway to optimize this to load faster?
Well, a “value” list driving a combo box is good for about 100, maybe 200 rows.
After that?
Don’t use a value list. Just shove the sql right into the combo/listbox data source.
Eg:
Me.Text18.Rowsource = "SELECT tbl5localidades.ID, tbl5localidades.NombreLocalidad FROM tbl5localidades;"
In fact, since the sql is not dynamic, then just place the sql right into the row source, and you don’t need any code at all.
You not mentioned how large this table is that drives the combo box, but Access will try and do its best to only pull the on row PK from that list until you open the combo box. So, don’t use “value/list”, but use sql for the combo box. You could also declare the record set at the forms level, and shove that into the combo box on form load as a data source, but using just the sql you have and no code likely will work the best.
A value list also has a hard limit of about 4000 characters, and thus that is another wall you can hit rather easy.
Do NOT use a pass-through query for this – the client cannot optimize the PT query, so a plane Jane linked table, and a plane Jane sql should work just fine.
And, of course change the combo box setting from value list to table/query
I have been looking for some code that creates a calendar year and will take data from a table and place it in the corresponding date on the calendar. I found some code online (from an older version of access) that pretty much fit the bill, with some modifications it does exactly what I need it to do. Originally, the code pulled data from one table and it was set up to run on the current year. I use two queries, qr_SafetyCal and qr_SafetyCal2, to refine data from the one table. The first query prioritizes the data and eliminates multiple events on any given day. The second query uses the results from the first and specifies the year in the query criteria.
The code works flawlessly as long as I set the year criteria in the qr_SafetyCal2 and specify the first day, ex. 1/1/2017 (datStart) in the underlying code of the calendar year I want displayed.
After getting the code squared away I created a pop up form the user to select the year for the report but when I run the report I get the following error, Runtime Error 3061 too few parameters expected 1.
From what I have been able to research, I believe I changed the dynamic of the code when I referenced the form in the query criteria that the DAO Recordset Used.
As I understand it, the criteria in the query is not passed to the rs and therefore needs to be declared in the code. What I can't figure out is how to declare the variables in the code through reference to the form. I hope that makes some sense to somebody, long explanation but hard to describe something you don't understand.
Below is all the code and you will see some things I've rem'd out that I have tried but did not work. Any help would be greatly appreciated. I apologize ahead of time if the code is not formatted correctly.
Option Compare Database
Option Explicit
Private m_strCTLLabel As String
Private m_strCTLLabelHeader As String
Private colCalendarDates As Collection
Function getCalendarData() As Boolean
Dim rs As DAO.Recordset
Dim strDate As String
Dim strCode As String
Dim i As Integer
'Dim qdf As DAO.QueryDef
'Set qdf = CurrentDb.QueryDef("qr_SafetyCal2")
'qdf.Parameters("[Forms]![fr_SafetyCal]![cboYear]") = [Forms]![fr_SafetyCal]![cboYear]
'Set rs = qdf.OpenRecordset("qr_SafetyCal2", dbOpenDynaset)
Set rs = CurrentDb.OpenRecordset("qr_SafetyCal2", dbOpenDynaset)
Set colCalendarDates = New Collection
With rs
If (Not .BOF) Or (Not .EOF) Then
.MoveLast
.MoveFirst
End If
If .RecordCount > 0 Then
For i = 1 To .RecordCount
strDate = .Fields("Date")
strCode = .Fields("ShortName")
colCalendarDates.Add strCode, strDate
.MoveNext
Next i
End If
.Close
End With
'Return of dates and data collection form qr_SafetyCal2
Set rs = Nothing
End Function
Public Sub loadReportYearCalendar(theReport As Report)
Dim i As Integer
Dim datStart As Date
Dim rptControl As Report
m_strCTLLabel = "labelCELL"
m_strCTLLabelHeader = "labelDAY"
'Load calendar data for the specified year into the collection
Call getCalendarData
With theReport
'Get the first month of the specified year
datStart = "1/1/2017" '"1/1/" & Year(Date), "1/1/" & Forms!
[fr_SafetyCal]![cboYear], Forms![fr_SafetyCal]![txtCalYear]
'Add the specified year to the report's label
.Controls("labelCalendarHeaderLine2").Caption = Year(datStart) & "
iCalendar"
For i = 1 To 12
'Set pointer to subreport control hosting the mini-calendar
Set rptControl = .Controls("childCalendarMonth" & i).Report
'Run procedure to populate control with it's respective year
Call loadReportCalendar(rptControl, datStart)
'Reset and obtain first day of the following month
datStart = DateAdd("m", 1, datStart)
Next i
End With
'Clean up
Set colCalendarDates = Nothing
Set rptControl = Nothing
End Sub
Public Sub loadReportCalendar(theReport As Report, Optional StartDate As
Date, Optional theHeaderColor As Variant)
Dim i As Integer
Dim intCalDay As Integer
Dim datStartDate As Date
Dim intWeekDay As Integer
datStartDate = StartDate
intWeekDay = Weekday(datStartDate)
With theReport
.Controls("labelMONTH").Caption = Format(StartDate, "mmmm")
'Change the day label's backcolor if necessary
If Not (IsMissing(theHeaderColor)) Then
For i = 1 To 7
.Controls("labelDayHeader" & i).BackColor = theHeaderColor
Next
End If
For i = 1 To 42
With .Controls(m_strCTLLabel & i)
If (i >= intWeekDay) And (Month(StartDate) =
Month(datStartDate)) Then
If (datStartDate = Date) Then
.BackColor = 14277081
End If
On Error Resume Next
Dim strCaption As String
Dim strKey As String
strKey = datStartDate
strCaption = ""
strCaption = colCalendarDates.Item(strKey)
colCalendarDates.Remove strKey
'Set back color to grean on days in the past that have
no corresponding event
If (datStartDate < Date) And (strCaption = vbNullString) Then
.Caption = Day(datStartDate)
.Bold = False
.BackColor = vbGreen
.ForeColor = vbWhite
.Heavy = True
'Do not set a back color for days in the future
ElseIf (datStartDate > Date) And (strCaption = vbNullString) Then
.Caption = Day(datStartDate)
.Bold = False
'Set the corresponding labels and formats for each specified event
Else
.Caption = strCaption
.Bold = True
Select Case strCaption
Case "FA"
.BackColor = vbYellow
.ForeColor = 0
.LeftMargin = 0
.TextAlign = 2
Case "FAM"
.BackColor = vbYellow
.ForeColor = 0
.LeftMargin = 0
.TextAlign = 2
.Heavy = True
Case "LTA"
.BackColor = vbRed
.ForeColor = vbWhite
.LeftMargin = 0
.TextAlign = 2
Case "MED"
.BackColor = vbRed
.ForeColor = vbWhite
.LeftMargin = 0
.TextAlign = 2
End Select
End If
datStartDate = DateAdd("d", 1, datStartDate)
Else
.Caption = ""
End If
End With
Next i
End With
End Sub
Here is SQL for the two queries, the first is qr_SafetyCal and the second is qr_SafetyCal2:
SELECT tb_CaseLog.Date, Max(tb_Treatment.Priority) AS MaxOfPriority,
Count(tb_Treatment.TreatmentID) AS CountOfTreatmentID
FROM tb_Treatment INNER JOIN tb_CaseLog ON tb_Treatment.TreatmentID =
tb_CaseLog.Treatment
GROUP BY tb_CaseLog.Date;
SELECT qr_SafetyCal.Date, tb_Treatment.ShortName,
qr_SafetyCal.CountOfTreatmentID AS [Count], Year([Date]) AS CalYear
FROM qr_SafetyCal INNER JOIN tb_Treatment ON qr_SafetyCal.MaxOfPriority =
tb_Treatment.Priority;
No need to reference QueryDef.
Open the recordset object with filtered dataset by referencing the combobox like:
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qr_SafetyCal2 WHERE CalYear=" & [Forms]![fr_SafetyCal]![cboYear], dbOpenDynaset)
or if the code is behind the form:
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qr_SafetyCal2 WHERE CalYear=" & Me.[cboYear], dbOpenDynaset)
Both examples assume the field is a number type.
If there is no field in query with the year value, it can be extracted from date value field in the VBA construct:
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qr_SafetyCal2 WHERE Year([YourFieldnameHere])=" & [Forms]![fr_SafetyCal]![cboYear], dbOpenDynaset)
Code for setting datStart variable:
'Get the first month of the specified year
datStart = "1/1/" & Forms![fr_SafetyCal].[cboYear]
I am using the below code to track changes on a form and it works fine.
However, I am trying to use it on my main form to record just the date/time that someone clicks a button However I get the following error:
You entered an expression that has no value
The debug takes me to this:
rs!PriorInfo = Screen.ActiveControl.OldValue
My code
Function TrackChanges()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strCtl As String
Dim strReason As String
' strReason = InputBox("Reason For Changes")
strCtl = Screen.ActiveControl.Name
strSQL = "SELECT Audit.* FROM Audit;"
Set db = CurrentDb()
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
If rs.RecordCount > 0 Then rs.MoveLast
With rs
.AddNew
rs!FormName = Screen.ActiveForm
rs!ControlName = strCtl
rs!DateChanged = Date
rs!TimeChanged = Time()
rs!PriorInfo = Screen.ActiveControl.OldValue
rs!NewInfo = Screen.ActiveControl.Value
rs!CurrentUser = fOSUserName
' rs!Reason = strReason
.Update
End With
Set db = Nothing
Set rs = Nothing
End Function
I assume I need to tell it to accept null values but unsure how?
Nz(Screen.ActiveControl.OldValue) will return an empty string instead of a null value.
Nz(Screen.ActiveControl.OldValue,"<Null>") if PriorInfo is text and you want to record it was null.
Nz(Screen.ActiveControl.OldValue,-1) if PriorInfo is numeric and -1 is a safe "null" number.
In a query I have an SQL iif statement that incorporates too many iif, therefore I cannot add any more iif, which is a problem.
To solve the problem, I had the idea to code a VBA function, but I am facing difficulties. Here is what I have, with a simple example where we have a Number in a field. In case the number is <0, the function Retrive() should retrieve the value of field TheDate, in case >0 the function should retrieve the value of the field TheOtherDate:
Public Function Retrive(NumberToCheck As Integer) As Date
Dim db As Database
Dim r As Recordset
Dim rsCount As Integer
Dim TheDate As Field, TheOtherDate As Field
Dim i As Integer
Set db = CurrentDb()
Set r = db.OpenRecordset("Table")
Set TheDate = r.Fields("TheDate")
Set TheOtherDate = r.Fields("TheOtherDate")
rsCount = r.RecordCount
r.MoveFirst
For i = 1 To rsCount
If NumberToCheck < 0 Then
Retrive = TheDate.Value
End If
If NumberToCheck > 0 Then
Retrive = TheOtherDate.Value
End If
r.MoveNext
Next i
End Function
But this does not work because it retrieves the last record for each line, not the right lines.
Your For loop just keeps running until you reach the last record and then exits. You have to jump out of the loop when you reach the correct record (you decide how to determine this).
Option Explicit
Public Function Retrive(NumberToCheck As Integer) As Date
Dim db As Database
Dim r As Recordset
Dim rsCount As Integer
Dim TheDate As Field, TheOtherDate As Field
Dim TheRightDate As Date
Dim i As Integer
Set db = CurrentDb()
Set r = db.OpenRecordset("Table")
Set TheDate = r.Fields("TheDate")
Set TheOtherDate = r.Fields("TheOtherDate")
rsCount = r.RecordCount
r.MoveFirst
TheRightDate = DateValue("1/15/2015")
For i = 1 To rsCount
If NumberToCheck < 0 Then
Retrive = TheDate.Value
'--- check here to see if you have the correct value
' and if so, the exit the loop
If Retrive = TheRightDate Then
Exit For
End If
End If
If NumberToCheck > 0 Then
Retrive = TheOtherDate.Value
'--- check here to see if you have the correct value
' and if so, the exit the loop
If Retrive = TheRightDate Then
Exit For
End If
End If
r.MoveNext
Next i
End Function
I have created a form where 1 customer can be stored multiple times in the database I have also created a 'Find Next' button which is working perfectly but when I make changes in the form and click on the update button the data is updated on the customer which is found first in the database and not the one that I want to update. below is the code to Update button.
Private Sub Command106_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim pn As Long
Set db = CurrentDb()
Set rs = db.OpenRecordset("Application", dbOpenDynaset)
pn = Me.Text85.Value
rs.FindFirst "[Cus_Number] = " & pn
rs.Edit
rs.Fields("Dec_level1").Value = Me.Dec_level1
rs.Fields("Dec_level2").Value = Me.Dec_level2
rs.Fields("Dec_level3").Value = Me.Dec_level3
rs.Fields("Date1").Value = Me.Date1
rs.Fields("Date2").Value = Me.Date2
rs.Fields("Date3").Value = Me.Date3
rs.Fields("Com_level1").Value = Me.Com_level1
rs.Fields("Com_level2").Value = Me.Com_level2
rs.Fields("Com_level3").Value = Me.Com_level3
rs.Update
Me.App_level1 = Null
Me.Dec_level1 = Null
Me.Com_level1 = Null
Me.App_level2 = Null
Me.Dec_level2 = Null
Me.Com_level2 = Null
Me.App_level3 = Null
Me.Dec_level3 = Null
Me.Com_level3 = Null
Me.Date1 = Null
Me.Date2 = Null
Me.Date3 = Null
Me.Text85 = Null
End Sub
FindFirst method always find the first matching record from the available records even if duplicate records are present in the database.
you are searching using Cus_Number field, is this the unique/primary field or can have duplicate records??
if having duplicate records then try searching with a record which is unique/primary in the database.