I have a main report (Projects Overview) which I am trying to create an OnClick event which will take me from the report to the field where that piece of information is entered on a form (LiveJobs).
My problem is that there is a subform (Estimate Items Subform) where the order items are entered. Then there is a subform on that (Production Subform) which is where the components that make up the 'Item' are entered. So a 'Desk' is ordered under 'Items' and then the components of the desk - drawer boxes, top, privacy panel are all entered on the Production Subform so they can all be tracked and monitored for production. As they are being produced there is time scheduled for each of these items in a time slot corresponding to a particular week.
In the report I want to be able to click on the time scheduled for any component and link back to the form and the corresponding week where it is scheduled and move hours around within the order form. My code will currently take me to the correct job but it wont get me to the correct 'layer' of the first subform and then to the correct layer of the component. Lets say for example the 3rd item in an order and then the 2 component of that Item.
Below is my code as it sits currently which only goes as far as trying to get to the correct item on the first subform. I figured if I could figure that out I could use the same logic to get to the correct component. This code results in a "Runtime Error '13' Type Mismatch"...I have been going round and round with this for days... Thanks in advance for any and all help.
Private Sub Estimated_hours_for_current_week_Click()
Dim strWhere As String
Dim DocName As String
DocName = "LiveJobs"
strWhere = "[Job Number]=" & "'" & Me![Job Number] & "'"
DoCmd.OpenForm DocName, acNormal, , strWhere
Forms![LiveJobs].[Estimate Items Subform].SetFocus
'find the Item in the item subform
Dim dbs As DAO.Database
Dim RstItem As DAO.Recordset
Dim strItemCriteria As Integer
Set dbs = CurrentDb
Set RstItem = dbs.OpenRecordset("Estimate Items Subform table", dbOpenDynaset)
strItemCriteria = "[Estimate Item subform table ID] = '" & Me.Estimate_Item_subform_table_ID & "'"
With RstItem
RstItem.MoveLast
DoEvents
RstItem.FindFirst strItemCriteria
Debug.Print (strItemCriteria)
If .NoMatch Then
MsgBox "No Match Found"
End If
End With
Set rs = Nothing
End Sub
I figured out the code. Here it is for reference.
Private Sub Estimated_hours_for_current_week_Click()
Dim frm1 As Form
Dim frm2 As Form
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
DoCmd.OpenForm "LiveJobs", _
WhereCondition:="[Job Number]=" & "'" & Me![Job Number] & "'"
Set frm1 = Forms!LiveJobs.Estimate_Items_Subform.Form
Set frm2 = Forms!LiveJobs.Estimate_Items_Subform!ProductionComponentSubform.Form
Set rst1 = frm1.Recordset.Clone
Set rst2 = frm2.Recordset.Clone
With rst1
.FindFirst "[Estimate Item subform table ID] =" & Me.Estimate_Item_subform_table_ID
If .NoMatch Then
MsgBox "Item not found"
Else
frm1.Bookmark = rst1.Bookmark
End If
End With
With rst2
.FindFirst "[Estimate details ID]=" & Me.Estimate_details_ID
If .NoMatch Then
MsgBox "project not found"
Else
frm2.Bookmark = rst2.Bookmark
Forms![LiveJobs].SetFocus
Forms![LiveJobs]![Estimate Items Subform].SetFocus
Forms![LiveJobs]![Estimate Items Subform]![ProductionComponentSubform].Form![Estimated
hours for current week].SetFocus
End If
End With
End Sub
Related
I just joined the site, I apologize in advance for the wrong English, I used google translate,
I used listview1 in vb 6, there is no problem with adding and deleting by clicking
What I want to do is to remove the number I wrote in the txtsearch.Text box on the form from the list, not index, it will only remove what I wrote in the txtsearch.Text box.
it should be like in the picture
i tried this but it only deletes as index it doesn't delete the line i wrote
Private Sub Command2_Click()
If ListView1.ListItems.Count <= 0 Then MsgBox "Nothing to remove", vbInformation, "": Exit Sub
ListView1.SelectedItem = ListView1.ListItems(Val(txtsearch.Text))
If vbYes = MsgBox("Are you sure you want to delete the selected item?", vbQuestion + vbYesNo, "") Then
ListView1.ListItems.Remove (ListView1.SelectedItem.Index)
End If
End Sub
thank you for your help
To select a desired row via the SelectedItem property, the Set keyword must be used.
Alternatively, the Selected property for the desired row can be set to True in order to select that row.
Try this:
Private Sub Command2_Click()
If ListView1.ListItems.Count <= 0 Then
MsgBox "Nothing to remove", vbInformation, ""
Exit Sub
End If
Set ListView1.SelectedItem = ListView1.ListItems(Val(txtsearch.Text))
' Or the following will also work
'ListView1.ListItems(Val(txtsearch.Text)).Selected = True
If vbYes = MsgBox("Are you sure you want to delete the selected item?", vbQuestion + vbYesNo, "") Then
ListView1.ListItems.Remove (ListView1.SelectedItem.Index)
End If
End Sub
Good eve guys.
I'm having a problem with my code.
The goal is, when I type a letter in the combobox, it wiill show a list of possible model names.
But whenever I type in that combobox, it gives me an error.
Here's the code I'm working on:
Private Sub cmbSearch_Change()
Dim conn As New ADODB.Connection
Dim record As New ADODB.Recordset
Dim model As String
model = cmbSearch.Text
If cmbSearch.Text <> "" Then
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & App.Path & "\Database.mdb"
cmbSearch.Clear
record.Open "SELECT Model FROM LaptopSpecs WHERE Model LIKE '" & model & "%' ORDER BY Model", conn, 3, 3
If record.RecordCount > 0 Then
Do While Not record.EOF
cmbSearch.AddItem record.Fields("Model").Value
record.MoveNext
Loop
End If
cmbSearch.Text = model
End If
Set record = Nothing
Set conn = Nothing
End Sub
In the part conn.open, the error message pops up.
run-time error '-2147467259(80004005)': unspecified error
Assuming you are using Access:
This question isn't about Access, but if it where:
Expanding on this answer, I recommend removing all the code in your example, and replacing it with this (done in Form design mode):
Set the cmbSearch.RowSource property to a fixed query like:
SELECT Model FROM LaptopSpecs ORDER BY Model
Set the cmbSearch Auto Expand to True.
This will work for 98% of all ComboBox type-to-select scenarios, and should work for your example.
I want to make an Excel workbook that I have much quicker.
I have a big product database with the product names, quantities, delivery number and delivery date (ProductDB). I put in another sheet the products that I have sold (product names and quantity sold) and want to filter and copy those that are corresponding from the database so I can calculate in the second step the remaining quantity and past the remaining quantity to the database.
Everything is working well and the calculation is good. The only thing is, the Advancedfilter xlfiltercopy option is too slow if I have to input 5000 lines of product names.
I have heard that arrays are much faster. How could I do that? The current way I do it is like this:
Sub UseFilter()
Application.ScreenUpdating = False
Sheet1.Range("G1:Z100000").Cells.Delete
Dim lastrow As Long, c As Range
Dim myrange As Range
Dim rngCell As Range
Dim wksSheet As Worksheet
Dim wksSheetDB As Worksheet
lastrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
Sheet1.Columns("G").NumberFormat = "0"
Filter product codes from the database according to sold product codes:
Set myrange = Range("A1:A" & lastrow)
For Each c In myrange
If Len(c.Value) <> 0 Then
ThisWorkbook.Worksheets(Worksheets.Count).Columns("A:D").AdvancedFilter xlFilterCopy, _
Sheet1.Range("A1:A" & lastrow), Sheet1.Range("G1"), False
End If
Next
Sort the filtered list first by product code, then by the delivery number:
Dim lngRowMax As Long
Dim wsf As WorksheetFunction
With Sheet1
lastrow = Cells(Rows.Count, 8).End(xlUp).Row
Range("G1:J" & lastrow).Sort Key1:=Range("G1:G" & lastrow), _
Order1:=xlAscending, Key2:=Range("I1:I" & lastrow), _
Order2:=xlAscending, Header:=xlYes, DataOption1:=xlSortTextAsNumbers
Set wsf = Application.WorksheetFunction
lngRowMax = .UsedRange.Rows.Count
End With
I'm only interested in filtering and copying of the corresponding product information (name (A), quantity (B), delivery nr (C) and date (D)). Does anyone know how I can do that?
Thank you very much in advance. I'm really looking forward for a solution that improves the pace of the file. Currently it is unbelievably slow.
i had the same problem with advanced filter being so slow. you might want to consider using dictionary. for my 2 spreadsheets i wanted to compare i made 2 dictionaries and compared the values and it was so amazingly fast. dictionaries are really easy and a simple google search you can find a ton of tutorials and examples. good luck.
There is a possible solution with dictionaries, but I have only one small issue. I will explain after the code:
'Count num rows in the database
NumRowsDB = ThisWorkbook.Worksheets(Worksheets.Count).Range("A2", Range("A2").End(xlDown)).Rows.Count
' --------------------- SAVE DATABASE DATA -----------------------
'Dictionary for all DB data
Set dbDict = CreateObject("Scripting.Dictionary")
Set dbRange = Range("A2:A" & (NumRowsDB + 1))
For Each SKU In dbRange
If Len(SKU.Value) <> 0 Then
' check if the SKU allready exists, if not create a new array list for that dictionary entry
' a list is necessary because there can be multiple entries in the db range with the same SKU
If Not dbDict.Exists(CStr(SKU.Value)) Then
Set prodList = CreateObject("System.Collections.ArrayList")
dbDict.Add CStr(SKU.Value), prodList
End If
' for this specific product code, save the range where the product information is saved in the dictionary
rangeStr = "A" & SKU.Row & ":D" & SKU.Row
dbDict(CStr(SKU.Value)).Add (rangeStr)
End If
Next
' ----------- READ SALE/Reverse/Consumption INFO ------------------
NumRowsSale = Range("A2", Range("A2").End(xlDown)).Rows.Count
Set saleRange = Range("A2:A" & (NumRowsSale + 1))
Dim unionRange As Range
For Each sale In saleRange
' check if the SKU for the sale exists in db
If Len(sale.Value) <> 0 And dbDict.Exists(CStr(sale.Value)) Then
For Each dbRange In dbDict(CStr(sale.Value))
If unionRange Is Nothing Then
Set unionRange = Range(dbRange)
Else
Set unionRange = Union(unionRange, Range(dbRange))
End If
Next
End If
Next
unionRange.Copy Destination:=Range("G2") 'copy all received ranges to G2
Set dbDict = Nothing
The line "NumRowsDB = ThisWorkbook.Worksheets(Worksheets.Count).Range("A2", Range("A2").End(xlDown)).Rows.Count" is not working. I have to refer to another sheet (the last sheet which is the current database) to get the data. What is the problem that I cannot refer to another sheet in the same workbook?
Thank you for your suggestions.
Private Sub txtUserCode_Validate(Cancel As Boolean)
If RS!ID = txtUserCode.Text Then
SQL = "SELECT NAME,PRIVILEDGE FROM ADMIN WHERE CODE=" & txtUserCode.Text
Set RS = CN.Execute(SQL)
txtUserName.Text = RS!NAME
Else
MsgBox "ENTER VALID NO"
txtUserCode.Text = ""
Cancel = True
End If
End Sub
In this code I want to execute like:
If I enter the ID present in table then it'll show info but it's considering 1st record (RS!ID(0)) only not the next one
If I enter the ID which is not present in table then it should not throw error
3021- Requested operation requires current record but goto else part.
Please Help
I am assuming RS is a recordset.
Depending on the RS type, you can try and Find a record like this:
RS.MoveFirst
RS.Find("[CODE]=" & txtUserCode.Text)
If Not RS.EOF Then
' found!
End If
Link to the ADO Find function.
Private Sub showreport_Click()
sql = "select * from student_record_database where"
sql=sql+ Grade='" & Combo1.Text & "' AND Meal='" & Combo11.Text & "'"
Set RES = CON.Execute(sql)
Set DataReport1.DataSource = RES
DataReport1.WindowState = vbMaximized
DataReport1.Show vbModal
End Sub
I am using this code as record set to create a data report.
My task is to choose options from various combo boxes and then display it's report so record set is needed there..
My question is that whether this code is sufficient to create data report???
I didn't set any properties of data environment or data report such as (connection - command - sql) because I am passing this record set directly to data report,then no need to fire any sql in properties of data environment.
But unfortunately it is not showing desired output
Please help me.
Try this one:
Private sub cmdprint_click()
Dim rs as new adodb.recordset
rs.open "SQL Query Statement Here",CON, adOpenDynamic, adLockOptimistic
set datareport1.datasource=rs
datareport1.show
end sub
Notes:
The data report datasouce should be cleared during design mode. (See properties on the datareport and set its datasource property to empty.) Ohhh...one more thing, please keep in mind that you should set also the datafield property for each textbox object inside the datareport corresponding to the datafield on your database during design time...
I am using this method for a long time and it works fine.
Try this.
To add a quite to a string, use a double quite.
Also you missed spelled the second Combo1 reference as Combo11
Private Sub showreport_Click()
sql = "select * from student_record_database where "
sql = sql & "Grade=""" & Combo1.Text & """ AND Meal=""" & Combo1.Text & """"
Set RES = CON.Execute(sql)
Set DataReport1.DataSource = RES
DataReport1.WindowState = vbMaximized
DataReport1.Show vbModal
End Sub