How to check if quantity is more or less on a table? - vba

I need to check if I have enough quantity of a specific product. How do I make it so the quantity that it checks is the one of the product in a textbox(txtIdProd).
This is my code:
Private Sub Cantidad_LostFocus()
Set myDatabase = CurrentDb()
Set myRs = myDatabase.OpenRecordset("TblProductos", dbOpenDynaset)
Dim cant As Integer
cant = txtCantidad
myRs.FindFirst "IDProducto=" & Me.txtIdProd
If myRs.NoMatch = False Then
If cant > myRs("CantidadDisponible") Then
Me.Label27.Visible = True
End If
End If
Exit Sub
Me.Label27.Visible = False
End Sub

The FindFirst code should do exactly what you want. However, probably more efficient to filter the recordset.
Private Sub Cantidad_LostFocus()
Dim cant As Integer
If Not IsNull(Me.txtIDProd) Then
Set myDatabase = CurrentDb()
Set myRs = myDatabase.OpenRecordset("SELECT CantidadDisponible FROM TblProductos WHERE IDProducto=" & Me.txtIdProd, dbOpenDynaset)
cant = rs!CantidadDisponible
End If
Me.Label27.Visible = Me.txtCantidad <= cant
End Sub
Another approach that doesn't use recordset:
Me.Label27.Visible = Me.txtCantidad <= Nz(DLookup("CantidadDisponible", "TblProductos", "IDproducto=" & Nz(Me.txtIDProd,0)), 0)
Note use of <= and assumes txtCantidad will not have 0.

Related

Print form on current record and records after current record

I have a simple SelectRecord/PrintSelected macro button to print the current record open on the form. The current record has a numeric textbox on the form named [Aantal], if [Aantal] has value 5, I want the print button to print the current record and the next 4 records after that, so 5 total.
I thought maybe something like this in the print VBA code.
Dim db As Database 'Current database.
Dim lng As Long 'Loop controller.
Dim rs As DAO.Recordset 'Table to append to.
Const conMaxRecords As Long = 20 'Number of records you want.
Set db = DBEngine(0)(0)
Set rs = db.OpenRecordset("Aantal")
With rs
For lng = 1 To conMaxRecords
.AddNew
!CountID = lng
.Update
Next
End With
rs.Close
Set rs = Nothing
Set db = Nothing
MakeData = "Records created."
For anyone that needs it, if your record has a column containing an amount. Let's say 5.
And you are standing on the first record, then this will print that first record and the 4 records after that, so total 5.
This is usefull if you have multiple records created after each other as a group, so they can be printed as a group instead of printing all records or doing it one by one.
Change: AantalForm to your textbox on the form containing the amount.
Private Sub PrintFrm_Click()
On Error GoTo 0
Dim t1 As Integer
Dim t2 As Integer
Dim j As Long
Dim frm As Form
Dim pgn As Integer
pgn = Me.CurrentRecord
t1 = Nz(Me.AantalForm, 1)
If t1 > 1 Then
t2 = pgn + t1 - 1
For j = pgn To t2
DoCmd.PrintOut acSelection
DoCmd.RunCommand acCmdRecordsGoToNext
Next j
Exit Sub
Else
t2 = 0
DoCmd.PrintOut acSelection
Exit Sub
End If
End Sub

Charts/graphs in Access VBA

How to initialize a chart with data in MS Access VBA? Eventually I found a suggestion here which with a bit of modification kept intellisense happy and resulted in this code:
Dim objchart As Chart
Dim arrData(3, 1) As Double
arrData(0, 0) = 1
arrData(1, 0) = 1
arrData(2, 0) = 1
arrData(3, 0) = 1
arrData(0, 1) = 1
arrData(1, 1) = 1
arrData(2, 1) = 1
arrData(3, 1) = 1
Set objchart = Me.Chart1
With objchart
.ChartTitle = "test"
.ChartType = acChartLine
.ChartValues = arrData
End With
But this throws
Compile error: Type mismatch
on the line
.ChartValues = arrData
I have tried it as "row-first" (arrData(1, 3)) and also just passing in a single array (arrData(3)). These both result in the same type mismatch error. While the intellisense is telling me that Chart1 exists, and that .ChartValues is a valid field, it doesn't tell me what kind of object it is expecting. I have googled extensively on this and come up empty. The best references I could find for Access VBA were Building VBA Apps and this but neither go into detail on Charts or ChartObjects.
Obviously I'd like to get past this type mismatch error. Even better would be if someone can give me some general advice on how to go about this when the closest thing to a language reference is silent on the part of the language you need.
This is one way to do it. First, create a new table and add some data:
Private Sub Form_Load()
Dim db As DAO.Database
Dim rec As Recordset
Dim tbl As DAO.TableDef
Set db = CurrentDb
Set tbl = db.CreateTableDef("tbl")
With tbl
.Fields.Append .CreateField("first", dbInteger)
.Fields.Append .CreateField("second", dbInteger)
End With
db.TableDefs.Append tbl
db.TableDefs.Refresh
Set rec = db.OpenRecordset("tbl")
rec.AddNew
rec("first").Value = 0
rec("second").Value = 2
rec.Update
rec.AddNew
rec("first").Value = 1
rec("second").Value = 2
rec.Update
rec.AddNew
rec("first").Value = 2
rec("second").Value = 2
rec.Update
rec.AddNew
rec("first").Value = 3
rec("second").Value = 2
rec.Update
Set rec = Nothing
Set db = Nothing
End Sub
Second, graph that data by referencing the new table:
Private Sub command0_click()
Dim objchart As Chart
Set objchart = Me.Chart1
With objchart
.ChartTitle = "tbl: second ~ first"
.RowSource = "tbl"
.ChartAxis = "first"
.ChartValues = "second"
End With
End Sub

access vba: go to next iteration on error

Listbox2 is populated from items in a table, which itself is populated from listbox1. An error will be thrown if an attempted addition to the table contains duplicate keys. I want my code to handle the error by skipping the problem iteration in question, instead of stopping halfway through the loop.
My code looks something like this:
Public Sub CopySelected(ByRef frm As Form)
Dim ctlSource As Control
Dim intCurrentRow As Integer
Set ctlSource = Me!listbox1
On Error GoTo nonrelation
Dim rst As dao.Recordset
Set rst = CurrentDb.OpenRecordset("Select * from [tempTable]")
For intCurrentRow = 0 To ctlSource.ListCount - 1
If ctlSource.Selected(intCurrentRow) Then
rst.AddNew
rst![field1] = Forms![myForm]![listbox1].Column(1, intCurrentRow)
rst![field2] = Forms![myForm]![listbox1].Column(0, intCurrentRow)
rst.Update
Forms![myForm]!listbox2.Requery
End If
Next intCurrentRow
Forms![myForm]!listbox2.Requery
done:
Exit Sub
nonrelation:
MsgBox Err.Description
End Sub
I know I have to use a 'resume' command somehow in place of my MsgBox Err.Description, but I've never used it. I would like to know how to properly implement that into my code. Thanks!
You could check if the record exists with a helper function and only add if not.
Public Function Exists(ByVal Value As String) As Boolean
Exists = DCount("*","tempTable","[field1]='" & Value & "'") > 0
End Function
Then inside your loop check each record before attempting to insert.
For intCurrentRow = 0 To ctlSource.ListCount - 1
If ctlSource.Selected(intCurrentRow) Then
If Not Exists(Forms![myForm]![listbox1].Column(1, intCurrentRow)) Then
With rst
.AddNew
![field1] = Forms![myForm]![listbox1].Column(1, intCurrentRow)
![field2] = Forms![myForm]![listbox1].Column(0, intCurrentRow)
.Update
End With
Forms![myForm]!listbox2.Requery
End If
End If
Next intCurrentRow
Note the above example expects a String. In case of a numeric, you will need to remove the ' ' quotes.

Excel VBA insert page break every nth row

I have the below code which does everything except insert the page break after row 35. can anyone help please?
Sub PrintSet()
Dim rs As Worksheet
Dim sPrintArea As String
sPrintArea = "A1:AE65"
For Each rs In Sheets
rs.PageSetup.Orientation = xlLandscape
rs.PageSetup.Zoom = False
rs.PageSetup.FitToPagesWide = 1
rs.PageSetup.FitToPagesTall = 2
rs.PageSetup.PrintArea = sPrintArea
rs.HPageBreaks.Add before:=Range("A36")
Next rs
End Sub
Rewrite the last line like this:
rs.HPageBreaks.Add before:=rs.Range("A36")
Thus, you are adding a reference rs also. It should work better. See what Microsoft says about referencing ranges:
https://msdn.microsoft.com/en-us/library/office/aa221547(v=office.11).aspx
Try something like this:
Dim hpgbr As HPageBreak
Dim hpgbrs As HPageBreaks
Set hpgbr = hpgbrs.Add(Before:=Range("A36"))
This works for me. I removed the Zoom
Sub PrintSet()
Dim rs As Worksheet
Dim sPrintArea As String
sPrintArea = "A1:AE65"
For Each rs In Sheets
rs.PageSetup.Orientation = xlLandscape
rs.PageSetup.FitToPagesWide = 1
rs.PageSetup.FitToPagesTall = 2
rs.PageSetup.PrintArea = sPrintArea
rs.HPageBreaks.Add before:=Range("A36")
Next rs
End Sub

How to get the last record id of a form?

I currently have a form in access.
What I want to do is get the value of the last record added.
For example, if i have 10 records, I want to get the value "10", because this is the id of the added last record. I am trying to run a query with the function last id inserted() but it is not working.
This the code I am using :
Dim lastID As Integer
Query = "select last_insert_id()"
lastID = Query
MsgBox (lastID)
What am I missing?
There is a function DMax that will grab the highest number.
Dim lastID As Integer
lastID = DMax("IDField","YourTable")
' or = DMax("IDField","YourTable","WhenField=Value")
MsgBox lastID
The other Domain functions are:
DAvg
DCount
DFirst
DLast
DLookup
DMin
DStDev
DStDevP
DSum
DVar
DVarP
Check with your friendly F1 key for more info
Following on from the last comments, here's a piece of code I used recently to turn the last ID value of a record set into variable for use in VBA. It's not great, however, because I still can't work out how to turn the record's ID field value directly into a variable. Instead I used the inelegant solution of copying the record set into an excel workbook, and then setting the variable value to the value of the cell I just copied into.
EDIT: Worked out how to turn the ID into a simple variable: new code at end
This is all run from a single client workbook:
Option Explicit
Public AftUpD As Long
Public BfrUpD As Long
Sub AssignLstRowAftUpD2()
Dim dbPP As DAO.Database
Dim ResTemp As DAO.Recordset
Dim z As Long
Dim SelectLast As String
SelectLast = "SELECT Max(Table1.ID) AS MaxOfID FROM Table1"
'Debug.Print SelectLast
Set dbPP = OpenDatabase("C:\filepath\Database11.mdb")
Set ResTemp = dbPP.OpenRecordset(SelectLast)
If ResTemp.EOF Then
GoTo EndLoop
End If
Worksheets("Diagnostics").Visible = True
Worksheets("Diagnostics").Range("C4").CopyFromRecordset ResTemp
z = Sheets("Diagnostics").Range("C4").Value
Sheets("Diagnostics").Visible = False
AftUpD = z
'Debug.Print AftUpD
EndLoop:
ResTemp.Close
dbPP.Close
Set dbPP = Nothing
Set ResTemp = Nothing
'Set SelectionLast = Nothing
'z = Nothing
End Sub
Then I used this value as a variable to make a new SQL query:
Sub Query()
'This query uses the highest ID value in a companion spreadsheet (the public
'variable BfrUpD), which is set in a sub I haven't posted here, to find out
'how many records have been added to the database since the last time the
'spreadsheet was updated, and then copies the new records into the workbook
'Be warned: If you run this query when BfrUpD is equal to or greater than AftUpD it
'will cause a crash. In the end user version of this, I use several If tests,
'comparing BfrUpD with other public variables, to make sure that this doesn't
'happen.
Dim WBout As Excel.Workbook, WSout As Excel.Worksheet
Dim dbPP1 As DAO.Database
Dim qryPP1 As DAO.Recordset
Dim ResTemp1 As DAO.Recordset
Dim TestValue As String
Dim strSQL2 As String
TestValue = BfrUpD
'Debug.Print TestValue
strSQL2 = "SELECT * FROM Table1 WHERE (((Table1.ID)>" & TestValue & "))"
'Debug.Print strSQL2
Set dbPP1 = OpenDatabase("C:\filepath\Database11.mdb")
Set qryPP1 = dbPP1.OpenRecordset(strSQL2)
Set WBout = Workbooks.Open("C:\filepath\h.xlsm")
Set WSout = WBout.Sheets("sheet1")
WSout.Range("A1").End(xlDown).Offset(1, 0).CopyFromRecordset qryPP1
qryPP1.Close
dbPP1.Close
WBout.Save
WBout.Close
MsgBox "Data copied. Thank you."
Set WBout = Nothing
Set WSout = Nothing
Set dbPP1 = Nothing
Set qryPP1 = Nothing
Set ResTemp1 = Nothing
End Sub
EDIT: Code for getting field value directly into variable
Dim dbPP As DAO.Database
Dim ResTemp As DAO.Recordset
Dim z As Long
Dim SelectLast As String
SelectLast = "SELECT Max(Table1.ID) AS MaxOfID FROM Table1"
'Debug.Print SelectLast
Set dbPP = OpenDatabase("C:\filepath\Database11.mdb")
Set ResTemp = dbPP.OpenRecordset(SelectLast)
z = ResTemp(0) 'specifying it's array location (I think) - there is only one
'item in this result, so it will always be (0)
AftUpD = z
'Debug.Print AftUpD
ResTemp.Close
dbPP.Close
Set dbPP = Nothing
Set ResTemp = Nothing
'Set SelectionLast = Nothing
'z = Nothing
End Sub
What you would do is set up and save a query that gets the value for you first. Call it MaxID
e.g
SELECT Max(ID) as result FROM Your_Table_Name
Then, in your VBA code, set your variable to that
eg.
Dim IDresult As Integer
IDresult = DLookup("[result]", "MaxID")
MsgBox(IDresult)