I have a multi select listbox, which I would like to make searchable. If the searched for value is found in the listbox, I'd like to scroll to that position, but not select it. Is this possible? The code I have so far for searching is :-
With lstComm
For i = 0 To .ListCount - 1
If .Column(6, i) = txtSearch.Value Then
End If
Next i
End With
...but I'm not sure how to complete the scroll.
This should work fine:
Dim index As Long
With lstComm
Dim match As Boolean
For index = 0 To .ListCount - 1
If .Column(1, index) = txtSearch.Value Then
match = True
Exit For
End If
Next
If Not match Then Exit Sub
Dim isSelected As Boolean
isSelected = .Selected(index)
.Selected(index) = True
.Selected(index) = isSelected
End With
It retrieves the searched item of the listbox.
If no item has been found it exits.
Otherwise it stores the current selection state of that item, selects it to position the listbox, and restores the stored state of the item.
Related
I'm trying to hide/unhide around 30 objects on my form when the user selects certain values from a dropdown menu. I tried the loop below, however I receive the following error: 'Object doesn't support this property or method.' I have this code running on the 'AfterUpdate' of the dropdown menu object.
Dim VisibleVisitFields() As String
Dim VisibleVisitFieldlist As String
Dim varVisibleVisit As Variant
VisibleVisitFieldlist = "VisitDate_Event,VisitTime_Event,VisitSite_Event,VisitStaff_Event,VisitMeet_Event"
VisibleVisitFields = Split(VisibleVisitFieldlist, ",")
If (EventType = 3) Then
For Each varVisibleVisit In VisibleVisitFields
[Forms]![subFRM_TBL_Event-All in One].Controls(varVisibleVisit).visible = True
Exit For
Next
Else
If (EventType <> 3) Then
For Each varVisibleVisit In VisibleVisitFields
[Forms]![subFRM_TBL_Event-All in One].Controls(varVisibleVisit).visible = False
Exit For
Next
End If
End If
Which line triggers the error? Suspect it is reference to the subform that is flawed. Never seen code like that to loop through an array. Suggest naming subform container different from the object it holds, such as ctrEvent. What is EventType - a textbox/field on the form? Consider code:
Dim aryFields As Variant
Dim x As Integer
aryFields = Split("VisitDate_Event,VisitTime_Event,VisitSite_Event,VisitStaff_Event,VisitMeet_Event", ",")
For x = 0 To UBound(aryFields)
Me.ctrEvent.Form.Controls(aryFields(x)).Visible = Me.EventType = 3
Next
Alternative methods not using array:
Set control Tag property then code loops through all controls on form and sets visibility for those that have particular value in Tag.
Dim ctrl As Control
For Each ctrl in Me.ctrEvent.Form.Controls
If ctrl.Tag = "something" Then ctrl.Visibility = Me.EventType = 3
Next
Another is to give controls similar names, like: Visit1, Visit2, etc. Then code:
Dim x As Integer
For x = 1 to 30
Me.ctrEvent.Form.Controls("Visit" & x).Visible = Me.EventType = 3
Next
Advise no spaces or punctuation/special characters (underscore only exception) in naming convention.
You are trying to iterate over an array of strings.
Dim VisibleVisitFields() As String
You need to declare the array to contain variants (which can still contain strings)
Dim VisibleVisitFields() As Variant
I have a list box that is populated by a recordset. I am trying to then select the items in that list box based on the values in another recordset. I am able to populate the list box, but when I try to select the values based on another recordset the list box Me.ToolUsed1 is Null. I call another function for selecting the values because I plan on using the same procedure for other list boxes. I really appreciate any help that you can provide.
'Populate the tool list box
While Not rsToolList.EOF
Me.ToolUsed1.AddItem Item:=rsToolList.Fields(0)
rsToolList.MoveNext
Wend
matchKey = "MatchKey = """ & rsActivities.Fields(0) & """"
If rsTools.RecordCount > 0 Then
rsTools.MoveFirst
rsTools.FindFirst (matchKey)
toolIndex = rsTools.Fields(2)
While Not rsTools.EOF
If (rsTools.Fields(2) = toolIndex) Then
SelectListValues Me.ToolUsed1, rsTools.Fields(1)
End If
rsTools.MoveNext
Wend
End If
Private Sub SelectListValues(tempListBox As Object, selectString As String)
Dim i As Integer
Dim found As Boolean
i = 0
found = False
'select the value in the listbox
While i < tempListBox.ListCount And Not found
If tempListBox.Value(i) = selectString Then
tempListBox.Selected(i) = True
found = True
End If
i = i + 1
Wend
'if the string wasn't found, add it
If Not found Then
tempListBox.AddItem (selectString)
End If
End Sub
Consider using a query recordsource for your listbox instead of value items to add. Listboxes like comboxes maintain the RowSource property, allowing for Table/Query sources which you can set to the first recordset, rsToolList. Then, just open one recordset, rsTools, and loop through it to decide selected items. Do note, with table/query sources the bound column is the value of the listbox, not any of the other columns.
' POPULATE TOOL LIST BOX TO QUERY
Me.tempListBox.RowSource = "ToolList" ' OR USE SELECT SQL STATEMENT HERE
Me.tempListBox.RowSourceType = "Table/Query"
Me.tempListBox.Requery
' LOOP THROUGH LISTBOX AND RECORDSET FOR SELECTED ITEMS
Dim rsTools As Recordset, i As Integer
Set rsTools = CurrentDb.OpenRecordset("Tools", dbOpenDynaset)
rsTools.MoveLast
rsTools.MoveFirst
If rsTools.RecordCount > 0 Then
While Not rsTools.EOF
i = 1
While i < Me.tempListBox.ListCount
' CHANGE C FUNCTION HERE TO NEEDED TYPE: CLng, CInt, CStr, CDate, ...
If CLng(Me.tempListBox.ItemData(i)) = rsTools.Fields(1) Then
Me.tempListBox.Selected(i) = True
End If
i = i + 1
Wend
rsTools.MoveNext
Wend
End If
rsTools.Close
Set rsTools = Nothing
I have a MS Access 2007 application which has several forms where I've used the same list box design. I have two list boxes, one of which gets values from a table with a query like:
SELECT id, value FROM table
And the second which is initially empty. In between these two list boxes are add and remove buttons, which are disabled by default. Clicking a value in the first list box enables the add button, and clicking a value in the second list box enables the remove button. Clicking the add button adds the selected item to the second list, and clicking the remove button removes an item for the second list.
The code I have for the add button is as follows ("ALLLIST" refers to the list with the query values, "SELECTEDLIST" is the one that's initially empty) :
Dim selectedId, selectedValue, safeValue As String
Dim existing As Boolean
Dim index As Integer
existing = False
selectedId = Me.ALLLIST.Value
index = Me.ALLLIST.ListIndex
selectedValue = Me.ALLLIST.Column(1,index)
'Loop through the list of selected values and see if this one has already been added to the list
For i = 0 To (Me.SELECTEDLIST.ListCount)
If (Me.SELECTEDLIST.Column(0, i) = selectedId) Then
existing = True
End If
Next i
'Only add the value if it's not already on the list
If (existing) Then
MsgBox "This list can't contain duplicate values", vbOKOnly + vbInformation, "Error"
Else
safeValue = Replace(selectedValue & "", "'", "''")
Me.SELECTEDLIST.AddItem (selectedId & ";'" & safeValue & "'")
Me.SELECTEDLIST.Value = Null
Me.REMOVEBUTTON.Enabled = False
End If
And the code for the remove button is:
Dim numItems, index As Integer
index = Me.SELECTEDLIST.ListIndex
'Remove the selected item and move to the top of the list
Me.SELECTEDLIST.RemoveItem (index)
Me.SELECTEDLIST.Selected(0) = True
numItems = Me.SELECTEDLIST.ListCount
'Cosmetic feature, select the row above the one we're removing
If (index > 0) Then
Me.SELECTEDLIST.Selected(index - 1) = True
Else
Me.SELECTEDLIST.Selected(0) = True
End If
'If the list is empty now, disable the remove button
If (numItems = 0) Then
Me.ALLLIST.SetFocus
Me.REMOVEBUTTON.Enabled = False
Me.SELECTEDLIST.Selected(-1) = True
End If
What I would like to do is, rather than copy and paste this code all over the place, have this template stored somewhere and then in my form code write something like:
hookUpLists(allListName, selectedListName, addButtonName, removeButtonName)
How can I do this? Can I write a module to do this some how? I'm also open to any improvements I can make on the above code.
Thanks
Thanks for the hint on using class modules, HK1, I'd never used them before.
To solve the original question, I created a new class module "MultiSelectListBox", which has the following code:
Option Compare Database
Private WithEvents allList As ListBox
Private WithEvents selectedList As ListBox
Private WithEvents addBtn As CommandButton
Private WithEvents removeBtn As CommandButton
Private numColumns As Integer
Public Sub hookUpLists(numberOfColumns As Integer, allValuesList As ListBox, selectedValuesList As ListBox, addButton As CommandButton, _
removeButton As CommandButton)
'Grab all the controls passed in
Set allList = allValuesList
Set selectedList = selectedValuesList
Set addBtn = addButton
Set removeBtn = removeButton
numColumns = numberOfColumns
'Tell Access we want to handle the click events for the controls here
allList.OnClick = "[Event Procedure]"
selectedList.OnClick = "[Event Procedure]"
addBtn.OnClick = "[Event Procedure]"
removeBtn.OnClick = "[Event Procedure]"
End Sub
Private Sub allList_Click()
addBtn.Enabled = True
End Sub
Private Sub selectedList_Click()
removeBtn.Enabled = True
End Sub
Private Sub addBtn_Click()
Dim selectedId As String
Dim existing As Boolean
Dim index As Integer
existing = False
selectedId = allList.Value
index = allList.ListIndex
'Loop through the list of selected values and see if this one has already been added to the list
For i = 0 To (selectedList.ListCount)
If (selectedList.Column(0, i) = selectedId) Then
existing = True
End If
Next i
'Only add the value if it's not already on the list
If (existing) Then
MsgBox "This list can't contain duplicate values", vbOKOnly + vbInformation, "Error"
Exit Sub
End If
Dim item As String
item = selectedId & ";"
'Loop over all of the columns and add them to the second list box
For i = 1 To numColumns - 1
item = item & "'" & Replace(allList.Column(i, index) & "", "'", "''") & "'"
'Don't add a trailing semicolon
If (i <> numColumns - 1) Then
item = item & ";"
End If
Next i
selectedList.AddItem (item)
selectedList.Value = Null
removeBtn.Enabled = False
'Select the next row
If (index <> allList.ListCount - 1) Then
allList.Selected(index + 1) = True
allList.Value = allList.Column(0, index + 1)
End If
End Sub
Private Sub removeBtn_Click()
Dim numItems, index As Integer
index = selectedList.ListIndex
'Remove the selected item and move to the top of the list
selectedList.RemoveItem (index)
selectedList.Selected(0) = True
numItems = selectedList.ListCount
'Cosmetic feature, select the row above the one we're removing
If (index > 0) Then
selectedList.Selected(index - 1) = True
Else
selectedList.Selected(0) = True
End If
'If the list is empty now, disable the remove button
If (numItems = 0) Then
allList.SetFocus
removeBtn.Enabled = False
selectedList.Selected(-1) = True
End If
End Sub
Most of the above is identical to what I was already using, one important thing to note for anyone stumbling across this is the use of "WithEvents" when declaring the variables. This tells Access to look in the class module for event handlers. Finally, from my form I can do the following:
Private contactList As MultiSelectListBox
Private Sub Form_Open(Cancel As Integer)
Set contactList = New MultiSelectListBox
contactList.hookUpLists 3, Me.allContactsList, Me.selectedContactsList, Me.addContactBtn, Me.removeContactBtn
End Sub
I'm trying to see if a list box is empty. I've seen the recommendation to use
If IsNull(txtLevel) Then
MsgBox "No Item is Selected"
but this is returning the error MsgBox even when items are select.
Another issue I have had in using other code If txtLevel.ListIndex = "-1" or If txtLevel.listount = 0 is it works well the first time, but if you select and then unselect, this doesn't trigger the error message.
Edit: the answer for me that works is: If txtLevel.ItemsSelected.Count = 0
You can also use the .ItemsSelected property which returns a variant array that contains the row number of the entries that are selected, or the .Selected property that returns True when the row specified in the parameter is selected.
The answer that works is "If txtLevel.ItemsSelected.Count = 0"
Try this code - see if you can see your solution in this. I left comments to explain what's going on.
ComboData is a combobox control
CheckNoComboData is a checkbox control
CheckSelection is a checkbox control
CheckNoSelection is a checkbox control
Code:
Dim intIter As Integer
Dim boolItems As Boolean
' Check if there is no Row Source data
If Nz(Me.ComboData.RowSource, "") = "" Then
Me.CheckNoComboData = True
Else
Me.CheckNoComboData = False
End If
' Check if there is a row source, but no
' items resulting from that rowsource
If Me.ComboData.ListCount = 0 Then
Me.CheckNoComboData = True
Else
Me.CheckNoComboData = False
End If
' Check if any items in the listbox are selected or not
Items = False
' Loop through each item in the combobox
For intIter = 0 To (Me.ComboData.ListCount - 1)
' If its selected, then we know items are selected
If Me.ComboData.Selected(intIter) Then
Items = True
Exit For
End If
Next
' Return Results
Me.CheckSelection = Items
Me.CheckNoSelection = Not Items
I have a form which includes a data sheet. I would like to make it possible for a user to select multiple rows, click on a button and have some sql query run and perform some work on those rows.
Looking through my VBA code, I see how I can access the last selected record using the CurrentRecord property. Yet I don't see how I can know which rows were selected in a multiple selection. (I hope I'm clear...)
What's the standard way of doing this? Access VBA documentation is somewhat obscure on the net...
Thanks!
I used the technique similar to JohnFx
To trap the Selection height before it disappears I used the Exit event of the subform control in the Main form.
So in the Main form:
Private Sub MySubForm_Exit(Cancel As Integer)
With MySubForm.Form
m_SelNumRecs = .SelHeight
m_SelTopRec = .SelTop
m_CurrentRec = .CurrentRecord
End With
End Sub
Here is the code to do it, but there is a catch.
Private Sub Command1_Click()
Dim i As Long
Dim RS As Recordset
Dim F As Form
Set F = Me.sf.Form
Set RS = F.RecordsetClone
If F.SelHeight = 0 Then Exit Sub
' Move to the first selected record.
RS.Move F.SelTop - 1
For i = 1 To F.SelHeight
MsgBox RS![myfield]
RS.MoveNext
Next i
End Sub
Here's the catch:
If the code is added to a button, as soon as the user clicks that button, the selection is lost in the grid (selheight will be zero). So you need to capture that info and save it to a module level variable either with a timer or other events on the form.
Here is an article describing how to work around the catch in some detail.
http://www.mvps.org/access/forms/frm0033.htm
Catch 2: This only works with contiguous selections. They can't select mutliple non-sequential rows in the grid.
Update:
There might be a better event to trap this, but here is a working implementation using the form.timerinterval property that i have tested (at least in Access 2k3, but 2k7 should work just fine)
This code goes in the SUBFORM, use the property to get the selheight value in the master form.
Public m_save_selheight As Integer
Public Property Get save_selheight() As Integer
save_selheight = m_save_selheight
End Property
Private Sub Form_Open(Cancel As Integer)
Me.TimerInterval = 500
End Sub
Private Sub Form_Timer()
m_save_selheight = Me.selheight
End Sub
I've tried doing something like that before, but I never had any success with using a method that required the user to select multiple rows in the same style as a Windows File Dialog box (pressing Ctrl, Shift, etc.).
One method I've used is to use two list boxes. The user can double click on an item in the left list box or click a button when an item is selected, and it will move to the right list box.
Another option is to use a local table that is populated with your source data plus boolean values represented as checkboxes in a subform. After the user selects which data they want by clicking on checkboxes, the user presses a button (or some other event), at which time you go directly to the underlying table of data and query only those rows that were checked. I think this option is the best, though it requires a little bit of code to work properly.
Even in Access, I find sometimes it's easier to work with the tables and queries directly rather than trying to use the built-in tools in Access forms. Sometimes the built-in tools don't do exactly what you want.
A workaround to the selection loss when the sub form loses the focus is to save the selection in the Exit event (as already mentioned by others).
A nice addition is to restore it immediately, using timer, so that the user is still able to see the selection he made.
Note: If you want to use the selection in a button handler, the selection may not be restored already when it executes. Make sure to use the saved values from the variables or add a DoEvents at the beginning of the button handler to let the timer handler execute first.
Dim m_iOperSelLeft As Integer
Dim m_iSelTop As Integer
Dim m_iSelWidth As Integer
Dim m_iSelHeight As Integer
Private Sub MySubForm_Exit(Cancel As Integer)
m_iSelLeft = MySubForm.Form.SelLeft
m_iSelTop = MySubForm.Form.SelTop
m_iSelWidth = MySubForm.Form.SelWidth
m_iSelHeight = MySubForm.Form.SelHeight
TimerInterval = 1
End Sub
Private Sub Form_Timer()
TimerInterval = 0
MySubForm.Form.SelLeft = m_iSelLeft - 1
MySubForm.Form.SelTop = m_iSelTop
MySubForm.Form.SelWidth = m_iSelWidth
MySubForm.Form.SelHeight = m_iSelHeight
End Sub
There is another solution.
The code below will show the number of selected rows as soon as you release the mouse button.
Saving this value will do the trick.
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
MsgBox Me.SelHeight
End Sub
Use a Global variable in the form, then refer to that in the button code.
Dim g_numSelectedRecords as long
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
g_numSelectedRecords = Me.SelHeight
End Sub
Dim formRecords As DAO.Recordset
Dim i As Long
Set formRecords = Me.RecordsetClone
' Move to the first record in the recordset.
formRecords.MoveFirst
' Move to the first selected record.
formRecords.Move Me.SelTop - 1
For i = 1 To numSelectedRecords
formRecords.Edit
formRecords.Fields("Archived") = True
formRecords.Update
formRecords.MoveNext
Next i
Why not use an array or recordset and then every time the user clicks on a row (either contiguous or not, save that row or some identifier into the recordset. Then when they click the button on the parent form, simply iterate the recordset that was saved to do what you want. Just don't forget to clear the array or recordset after the button is clicked.?
Another workaround to keeping the selection while attempting to execute a procedure - Instead of leaving the datasheet to activate a button, just use the OnKeyDown event and define a specific keycode and shift combination to execute your code.
The code provided by JohnFx works well. I implemented it without a timer this way (MS-Access 2003):
1- Set the Form's Key Preview to Yes
2- put the code in a function
3- set the event OnKeyUp and OnMouseUp to call the function.
Option Compare Database
Option Explicit
Dim rowSelected() As String
Private Sub Form_Load()
'initialize array
ReDim rowSelected(0, 2)
End Sub
Private Sub Form_Current()
' if cursor place on a different record after a selection was made
' the selection is no longer valid
If "" <> rowSelected(0, 2) Then
If Me.Recordset.AbsolutePosition <> rowSelected(0, 2) Then
rowSelected(0, 0) = ""
rowSelected(0, 1) = ""
rowSelected(0, 2) = ""
End If
End If
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
rowsSelected
If KeyCode = vbKeyDelete And Me.SelHeight > 0 Then
removeRows
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
rowsSelected
End Sub
Sub rowsSelected()
Dim i As Long, rs As DAO.Recordset, selH As Long, selT As Long
selH = Me.SelHeight
selT = Me.SelTop - 1
If selH = 0 Then
ReDim rowSelected(0, 2)
Exit Sub
Else
ReDim rowSelected(selH, 2)
rowSelected(0, 0) = selT
rowSelected(0, 1) = selH
rowSelected(0, 2) = Me.Recordset.AbsolutePosition ' for repositioning
Set rs = Me.RecordsetClone
rs.MoveFirst ' other key touched caused the pointer to shift
rs.Move selT
For i = 1 To selH
rowSelected(i, 0) = rs!PositionNumber
rowSelected(i, 1) = Nz(rs!CurrentMbr)
rowSelected(i, 2) = Nz(rs!FutureMbr)
rs.MoveNext
Next
Set rs = Nothing
Debug.Print selH & " rows selected starting at " & selT
End If
End Sub
Sub removeRows()
' remove rows in underlying table using collected criteria in rowSelected()
Me.Requery
' reposition cursor
End Sub
Private Sub cmdRemRows_Click()
If Val(rowSelected(0, 1)) > 0 Then
removeRows
Else
MsgBox "To remove row(s) select one or more sequential records using the record selector on the left side."
End If
End Sub