Part of the issue is opening the table for the record set and having to set focus to the subform. I have been unsuccessful in sorting the table through vba. The goal is to find the MEDIAN value of a table, hence the sorting.
Private Sub cboUser_AfterUpdate()
Dim sourceReset As String
Dim dbMedian As DAO.Database
Dim rsMedian As DAO.Recordset
sourceReset = sbf.SourceObject '<--Is Table.TEMPtable btw.
Me.sbf.SourceObject = ""
Forms!frm.Requery
Forms!frm.Refresh
'Create new TEMPtable
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryTEMPtable" '<--Is sorted here as desired
DoCmd.SetWarnings True
Set dbMedian = CurrentDb()
Set rsMedian = dbMedian.OpenRecordset("TEMPtable") '<--Gets unsorted here
sbf.SourceObject = sourceReset
Me.OrderBy = "NetWrkDays ASC" '<--Re-sorting, but on subform, which.. is
fine if I can return the column value later.
Forms!frm.Refresh
Me.[sbf].SetFocus
Records= DCount("[ColA]", "TEMPtable")
'Even number of records
If Records - 2 * Int(Records / 2) = 0 Then
MEDrcd = Records / 2
DoCmd.GoToRecord , , acGoTo, MEDrcd '<-Can see value in debug, how to
assign it to a useful variable???
''''Me.CurrentRecord ("NetWrkDays")
''''Me.RecordSource ("NetWrkDays")
Me.txtMED = rsMedian("NetWrkDays")
End If
'Odd number of records
If Records - 2 * Int(Records / 2) = 1 Then
MEDrcd1 = (Records - 1) / 2
MEDrcd2 = (Records + 1) / 2
DoCmd.GoToRecord acDataForm, "TempTable", acGoTo, MEDrcd1
MED1 = rsMedian("NetWrkDays")
DoCmd.GoToRecord acDataForm, "TempTable", acGoTo, MEDrcd2
MED2 = rsMedian("NetWrkDays")
Me.txtMED = (MED1 + MED2) / 2
End If
I guess I see no point in trying to use DoCmd.GoToRecord if you cant return the value at that point.
What is the best/correct method for returning a value after moving to a record.
As the subform and table are the same, I just ran with setting focus to the subform as I said was having issue sorting the table in vba. Though then me using rsMedian makes no sense, as the table rs never moves...but I cant retrieve a value for moving though the subform using GoToRecord.
I am going in circles here and i hope is not to garbled to understand. Thank you.
Found this method online. Is working great in case anyone else finds themselves in a similar situation.
Private Sub cboUser_AfterUpdate()
Dim sourceReset As String, sqlMED As String, sTable As String, sField As String
Dim j As Integer, varVal As Single
Dim rs As DAO.Recordset
sourceReset = sbf.SourceObject
Me.sbf.SourceObject = ""
Forms!frmSTATS.Requery
Forms!frmSTATS.Refresh
'Create new TEMPtable table
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryTEMPtable"
DoCmd.SetWarnings True
'Get MEDIAN Data/Value
sTable = "TEMPtable"
sField = "NetWrkDays"
sqlMED = "SELECT " & sField & " from " & sTable & " WHERE " & sField & ">0 Order by " & sField & ";"
Set rs = CurrentDb.OpenRecordset(sqlMED)
rs.MoveLast
j = rs.RecordCount
rs.Move -Int(j / 2)
If j Mod 2 = 1 Then 'odd number of elements
getMedian = rs(sField)
Else 'even number of elements
varVal = rs(sField)
rs.MoveNext
varVal = varVal + rs(sField)
getMedian = varVal / 2
End If
Me.txtAnswer = getMedian
rs.Close
sbf.SourceObject = sourceReset
Me.OrderBy = "NetWrkDays ASC"
Forms!frmSTATS.Refresh
End Sub
Related
I am "creating" my first loop, I copied code and am trying to get it to work. I have the loop functioning but when I try to do a Dlookup in the middle of the loop it does not work.
I am sure there are some ways to make this code work better, Just trying to retrieve dynamic data for the body of my email.
Here is the relevant part of the loop.
strSQL = "SELECT * FROM emailbody Where EmailMainID = " & Me.EmailMainID
Set rs = CurrentDb.OpenRecordset(strSQL)
With rs
If Not .BOF And Not .EOF Then
.MoveLast
.MoveFirst
While (Not .EOF)
LookupInfo = rs.Fields("beforetable") & "-" & rs.Fields("beforefield") 'Get Table and Field to lookup
LookupLen = Len(LookupInfo) 'Find how many letters are in the string
SubtractLen = InStr(1, [LookupInfo], "-") ' Find the number of letters to the left
RightCut = LookupLen - SubtractLen ' Find how many are to the right
Table = Left([LookupInfo], InStr(1, [LookupInfo], "-") - 1) ' Set the table value
Field = Right([LookupInfo], RightCut) ' Set the Field Value
InfoInsert = DLookup("Table", "Field", TeamDetailsID = 39)
FreshData = rs.Fields("emailbodyid") & " " & rs.Fields("bodycontent")
LongEmail = EmailMe & FreshData
EmailMe = LongEmail
FreshData = ""
LongEmail = ""
.MoveNext
Wend
End If
.Close
End With
it should be:
InfoInsert = DLookup("Table", "Field", "TeamDetailsID = 39")
or, if you use a variable
InfoInsert = DLookup("Table", "Field", "TeamDetailsID = " & idteam)
So I my most recent test tells me my difficulty is not the loop.
I tested the code this way (Yes I had the field and the table mixed up in the above example)
I get the result in Test2 But not Test1
Dim Table As String
Dim Field As String
Table = TeamDetails
Field = DepartDate
test2 = DLookup("DepartDate", "TeamDetails", "TeamDetailsID = 39")
MsgBox test2
test1 = DLookup("Field", "Table", "TeamDetailsID = 39")
MsgBox test1
I have a listview box that gets populated with five items. Here's the code that I used to populate it
Dim rs As New ADODB.Recordset
Set rs = New ADODB.Recordset
Dim lvwItem As ListItem
Dim x As Integer
lvwExpenditures.ListItems.Clear
With lvwExpenditures
.FullRowSelect = True
.View = lvwReport
.LabelEdit = lvwManual
.ColumnHeaders.Add , "FldName", "EXPENSES", 2200
.ColumnHeaders.Add , "ID", "ID", 0
End With
g_strSQL = "Select FldName, ID, Label, SortOrder from dbo.tblText_References where fldname ='expenditureitems'"
rs.Open g_strSQL, g_cnDatabase, adOpenStatic
Debug.Print g_strSQL
With rs
Do While Not .EOF
Set lvwItem = lvwExpenditures.ListItems.Add(, , .Fields("Label").Value)
lvwItem.SubItems(1) = .Fields("ID").Value 'Populate Date column
.MoveNext
Loop
End With
Set rs = Nothing
What I'm trying to do is let the user select multiple items, concatenate the items (with a comma) and insert them into a table. Here's the code I have for trying to take the selected items and concatenate them (I built a function), but the issue is, it takes one of the items, and concatonates it three times (when three items were selected in listview). I show the label and save the ID, so the when listview is loaded the ID's go in this order 10,11,12,13,14. On my last try, I selected the top three items and the function converted it to (13,13,13). How do I fix it? I know its a small issue
dim x As Integer
Dim mystring As String
For x = 1 To lvwExpenditures.ListItems.Count
If lvwExpenditures.ListItems(x).Selected = True Then
If x = 1 Then
mystring = lvwExpenditures.SelectedItem.SubItems(1)
Else
mystring = mystring & "," & lvwExpenditures.SelectedItem.SubItems(1)
End If
Else
End If
Next x
dim x As Integer
Dim mystring As String
dim sep as string
sep=", "
For x = 1 To lvwExpenditures.ListItems.Count
If lvwExpenditures.ListItems(x).Selected Then
mystring = mystring & lvwExpenditures.ListItems(x).SubItems(1) & sep
End If
Next x
if mystring<>"" then
mystring=left(mystring,len(mystring)-len(sep)
end if
I have multiple records with the same customer number and I using Find next method to search for the next record with the customer number is same. my code will only search for the 2nd record and not go for the 3rd or 4th search for the same customer number. below is the code can you please help
Private Sub Command114_Click()
Dim db As dao.Database
Dim rs1 As dao.Recordset
Dim pn As Long
Set db = CurrentDb()
Set rs1 = db.OpenRecordset("Application", dbOpenDynaset)
If (Text85 & vbNullString) = vbNullString Then
MsgBox "Please enter the Account no/CIF"
Else
pn = Me.Text85.Value
rs1.FindNext "[Cus_Number] = " & pn
If rs1.NoMatch Then
MsgBox ("Sorry The Accountno/CIF is not found")
Else
Me.S_No = rs1.Fields("sno").Value
Me.Cus_Name = rs1.Fields("Cus_Name").Value
Me.App_level1 = rs1.Fields("App_level1").Value
Me.App_level2 = rs1.Fields("App_level2").Value
Me.App_level3 = rs1.Fields("App_level3").Value
Me.Dec_level1 = rs1.Fields("Dec_level1").Value
Me.Dec_level2 = rs1.Fields("Dec_level2").Value
Me.Dec_level3 = rs1.Fields("Dec_level3").Value
Me.Com_level1 = rs1.Fields("Com_level1").Value
Me.Com_level2 = rs1.Fields("Com_level2").Value
Me.Com_level3 = rs1.Fields("Com_level3").Value
Me.Date1 = rs1.Fields("Date1").Value
Me.Date2 = rs1.Fields("Date2").Value
Me.Date3 = rs1.Fields("Date3").Value
End If
End If
rs1.FindNext "[Cus_Number] = " & pn
Set rs1 = Nothing
End Sub
I am assuming the functionality you want is to change all instances (2, 3, 4 etc.) to the values entered. Remove this (the one near the end, after the End If):
rs1.FindNext "[Cus_Number] = " & pn
and put the FindNext into a loop which will keep on finding and updating your records until there is NoMatch:
rs1.FindNext "[Cus_Number] = " & pn
If rs1.NoMatch Then
MsgBox ("Sorry The Accountno/CIF is not found")
Else
Do Until rs1.NoMatch
Me.S_No = rs1.Fields("sno").Value
Me.Cus_Name = rs1.Fields("Cus_Name").Value
Me.App_level1 = rs1.Fields("App_level1").Value
Me.App_level2 = rs1.Fields("App_level2").Value
Me.App_level3 = rs1.Fields("App_level3").Value
Me.Dec_level1 = rs1.Fields("Dec_level1").Value
Me.Dec_level2 = rs1.Fields("Dec_level2").Value
Me.Dec_level3 = rs1.Fields("Dec_level3").Value
Me.Com_level1 = rs1.Fields("Com_level1").Value
Me.Com_level2 = rs1.Fields("Com_level2").Value
Me.Com_level3 = rs1.Fields("Com_level3").Value
Me.Date1 = rs1.Fields("Date1").Value
Me.Date2 = rs1.Fields("Date2").Value
Me.Date3 = rs1.Fields("Date3").Value
rs1.FindNext "[Cus_Number] = " & pn
Loop
End If
In general, though, I'm not sure what you are looking to do. Are you looking to update the recordset with the latest information on the form? The code you have will overwrite the current values on the form with the last set of found values in the recordset. I would have thought you want the opposite...
I have the following code to loop through two tables and merge them into a new table:
Public Function MyFunction()
Dim Db As DAO.Database
Dim rst(1 To 3) As DAO.Recordset
Dim fld As DAO.Field
Dim fldname, fldtype As String
Dim PxID As Integer
Dim Iter, Counter As Integer
Set Db = CurrentDb
Set rst(1) = Db.OpenRecordset("Table1")
Call PrepTable ' Creates table named Test
rst(1).MoveFirst
Do While Not rst(1).EOF
PxID = rst(1)!PersonID
Set rst(2) = Db.OpenRecordset("SELECT * FROM Table2 WHERE PersonID=" & PxID)
If rst(2).RecordCount > 0 Then
rst(2).MoveLast
'set limit to 4 records if recordcount > 4
Iter = IIf(rst(2).RecordCount > 4, 4, rst(2).RecordCount)
rst(2).MoveFirst
For Counter = 1 To Iter
For Each fld In rst(2).Fields
If fld.OrdinalPosition = 0 Then
fldname = "PersonID"
Else
fldname = fld.Name & Trim(Str(Counter))
End If
If Not IsNull(fld.Value) Then
Set rst(3) = Db.OpenRecordset("Test")
'create new record on Test only if on new record on Table2
If (fldname = "PersonID" And Counter = 1) Then
rst(3).AddNew
Else
rst(3).Move 0
rst(3).Edit
End If
rst(3)(fldname).Value = fld.Value
rst(3).Update
rst(3).Bookmark = rst(3).LastModified 'not sure about this at all
End If
Next
rst(2).MoveNext
Next
rst(3).Close
End If
rst(2).Close
Set rst(2) = Nothing
Set rst(3) = Nothing
rst(1).MoveNext
Loop
rst(1).Close
Set rst(1) = Nothing
Debug.Print "Done."
Db.TableDefs.Refresh
DoCmd.OpenTable "Test", acViewNormal
End Function
Table1 contains 10 records. This function correctly creates 10 records on the Test table. However, only the first record is being updated (causing new data to overwrite the old). The last 9 records are blank save for the autonumber field of table Test and the PersonID field.
The basic question is: How do I move to the next row for the edit and update?
What you are trying to accomplish is really not entirely clear.
From what I understand, you are trying to transpose the first 4 records of Table2 into columns in table Temp.
Here, you are opening your rs(3) every for every field you loop through, but you never close it within that loop; you close it outside of the loop, at a level where it may not even be open...
So, first thing is to move that Set rst(3) = Db.OpenRecordset("Test") outside of all the loops.
Then it's not clear why you are doing with the rst(3).Move 0 and the rst(3).Bookmark = rst(3).LastModified.
Once you have added a new record, you do not need to call Edit on it again, or move around records and bookmakrs. All you need to do is make sure you call rst(3).Update after you copied all the field data.
Public Function MyFunction()
Dim Db As DAO.Database
Dim rst(1 To 3) As DAO.Recordset
Dim fld As DAO.Field
Dim fldname, fldtype As String
Dim PxID As Integer
Dim Iter, Counter As Integer
Set Db = CurrentDb
Set rst(1) = Db.OpenRecordset("Table1")
Call PrepTable ' Creates table named Test
rst(1).MoveFirst
Set rst(3) = Db.OpenRecordset("Test")
Do While Not rst(1).EOF
PxID = rst(1)!PersonID
Set rst(2) = Db.OpenRecordset("SELECT * FROM Table2 WHERE PersonID=" & PxID)
If rst(2).RecordCount > 0 Then
rst(2).MoveLast
'set limit to 4 records if recordcount > 4
Iter = IIf(rst(2).RecordCount > 4, 4, rst(2).RecordCount)
rst(2).MoveFirst
For Counter = 1 To Iter
For Each fld In rst(2).Fields
If fld.OrdinalPosition = 0 Then
fldname = "PersonID"
Else
fldname = fld.Name & Trim(Str(Counter))
End If
If Not IsNull(fld.Value) Then
'create new record on Test only if on new record on Table2
If (fldname = "PersonID" And Counter = 1) Then
rst(3).AddNew
End If
rst(3)(fldname).Value = fld.Value
End If
Next
If rs(3).EditMode <> dbEditNone Then
rst(3).Update
End If
rst(2).MoveNext
Next
End If
rst(2).Close
Set rst(2) = Nothing
rst(1).MoveNext
Loop
rst(3).Close
rst(1).Close
Set rst(3) = Nothing
Set rst(1) = Nothing
Debug.Print "Done."
Db.TableDefs.Refresh
DoCmd.OpenTable "Test", acViewNormal
End Function
I'm not saying this will work, and you could certainly clean up the logic in that code, but this should make it a bit better already.
I'm trying to make it so that when a user selects a person from a combobox their full details are displayed but some error-handling if statements keep giving false when the conditions should be returning true
Private Sub ComboOwnerID_Change()
Dim SelID As Integer
Dim rs As DAO.Recordset
Dim db As Database
Dim strSQL As String
Dim result As String
SelID = 0
SelID = Me.ComboOwnerID.Text
If Not (SelID = 0) Then
If Not (SelID = Null) Then
Set db = CurrentDb
strSQL = "SELECT * FROM Owners WHERE OwnerID = " + SelID
Set rs = db.OpenRecordset(strSQL)
Do While Not rs.EOF
result = ""
result = rs!Title + ". "
result = result + rs!Forname + " "
result = result + rs!Surname
rs.MoveNext
Loop
Me.lblOwnerName.Caption = result
Else
Me.lblOwnerName.Caption = "error"
End If
Else
Me.lblOwnerName.Caption = "error"
End If
End Sub
It's not even reached the SQL bit yet so i don't know if that works or not
Do not use the .text property in VBA, it is only available when the control has focus. The concatenator in VBA is & not +. Using + when one of the strings is null can return null.
If Not (SelID = Null) Then
Set db = CurrentDb
You mean:
If Not IsNull(SelID) Then
Set db = CurrentDb