I have created a UserForm in VBA Excel that has a ListBox with the ListStyleOption selected. The MultiSelectMulti option is activated.
Whenever I close the UserForm or Workbook and then reopen, all the previous selections are gone. Is there a way to retain selections made in listbox?
Thanks.
Yes, it's possible, but you have to save the listbox items and their selected state in the workbook or some data support such as a file or database. When showing your form, you'll just read back the saved items and selected states.
Assuming you can save the list's content in the workbook, you can use something like the following:
Public Sub SaveList(ByVal plstListBox As MSForms.ListBox, ByVal prngSavePoint As Excel.Range)
On Error GoTo errHandler
Dim lRow As Long
Dim bScreenUpdating As Boolean
Dim bEnableEvents As Boolean
bScreenUpdating = Application.ScreenUpdating
bEnableEvents = Application.EnableEvents
Application.ScreenUpdating = False
Application.EnableEvents = False
prngSavePoint.CurrentRegion.Clear
If plstListBox.ListCount > 1 Then
For lRow = 0 To plstListBox.ListCount - 1
prngSavePoint.Cells(lRow + 1, 1).Value = plstListBox.Selected(lRow)
prngSavePoint.Cells(lRow + 1, 2).Value = plstListBox.List(lRow)
Next
End If
Cleanup:
On Error Resume Next
Application.EnableEvents = bEnableEvents
Application.ScreenUpdating = bScreenUpdating
Exit Sub
errHandler:
MsgBox Err.Description, vbExclamation + vbOKOnly, "Error"
Resume 'Cleanup
End Sub
Public Sub LoadList(ByVal plstListBox As MSForms.ListBox, ByVal prngSavePoint As Excel.Range)
Dim lRow As Long
Dim vntSavedList As Variant
plstListBox.Clear
If Not IsEmpty(prngSavePoint.Cells(1, 1).Value) Then
vntSavedList = prngSavePoint.CurrentRegion.Value
For lRow = 1 To UBound(vntSavedList, 1)
plstListBox.AddItem vntSavedList(lRow, 2)
plstListBox.Selected(lRow - 1) = vntSavedList(lRow, 1)
Next
End If
End Sub
To save (e.g. you could have a Save List button on your form), pass a reference to your listbox, and a reference to the top left cell of a free zone somewhere in your workbook. Beware that the code will write from this point down, on 2 columns, and overwrite everything that may be in its path. You must also be sure that this cell is isolated, i.e. not immediately adjacent to other content in any direction.
Example: SaveList ListBox1, Sheet1.Cells(1, 1)
You could have a Load List button on your form. To load back your list: LoadList ListBox1, Sheet1.Cells(1, 1)
The important listbox properties used in this answer are Selected and List, which give the selected state and label of any item in the list. These are zero-based indexed properties.
Related
I'm creating a simple form in excel that will run in a touch device. In some part of the form i have created a dropdown validation list. I need to go to the next and previous item in the validation list with a button.
The only way thay i found is using Application.Sendkeys to acces to the dropdown but is not working. Any thoughts?
sub Next_item click()
ActiveSheet.Range(cell_rng.Text).Select
Application.SendKeys ("%{Down}")
Application.SendKeys ("{Down}{Enter}")
End Sub
You might consider going to the source of the data validation and grabbing the next item rather than trying to manipulate the in-cell dropdown directly. For instance, if you data validation is a comma-separated list
you could use code like this to get the next value:
Public Sub NextItem()
Dim dv As Validation
Dim vaSplit As Variant
Dim i As Long
'Formula1 contains the comma sep list of values
Set dv = ActiveCell.Validation
vaSplit = Split(dv.Formula1, ",")
For i = LBound(vaSplit) To UBound(vaSplit)
'if you're at the currently selected one
If vaSplit(i) = ActiveCell.Value Then
'but not at the last one
If i < UBound(vaSplit) Then
'select the next one
ActiveCell.Value = vaSplit(i + 1)
Exit For
End If
End If
Next i
End Sub
And if your list comes from a simple range
you could use almost the same code
Public Sub NextItemRange()
Dim dv As Validation
Dim vaSplit As Variant
Dim i As Long
Set dv = ActiveCell.Validation
vaSplit = Range(dv.Formula1).Value
For i = LBound(vaSplit, 1) To UBound(vaSplit, 1)
If vaSplit(i, 1) = ActiveCell.Value Then
If i < UBound(vaSplit, 1) Then
ActiveCell.Value = vaSplit(i + 1, 1)
Exit For
End If
End If
Next i
End Sub
Dynamic ranges or tables might throw a wrench into it, but hopefully it's a start.
I have a worksheet where there is a list of car parts pending delivery from the factory. I need to populate column I with a checkbox in each cell.
I created a button called "CREATE CHECKBOXES" that looks at how many rows of data exists then populates each cell of column I with ActiveX checkboxes from CheckBox1 up to CheckboxN (n = number of rows containing data). That part is already figured out.
Next when the user checks any of the checkboxes, it must pop up a userform with 2 data field inputs that will be inserted on column J and K in the same row of the checked checkbox. Where I got stuck in the code is the event that triggers the userform to pop when any of the checkboxes is checked.
I saw Event triggered by ANY checkbox click), but now due to the code counting the checkboxes as shapes, I can't add any sort of button to add a macro to it.
I had to delete the "CREATE CHECKBOXES" button, otherwise the code from the linked post won't work.
How can I make this userform trigger event happen when any of the checkboxes are checked and maintain the shape buttons?
A few things must happen after that, but I think I can handle it.
I created a class module, named ChkClass, with this code:
' put all this code in class a module and name the class module "ChkClass"
Option Explicit
Public WithEvents ChkBoxGroup As MSForms.CheckBox
Private Sub ChkBoxGroup_Change()
Debug.Print "ChkBoxGroup_Change"
End Sub
Then pasted this in the sheet code:
' this goes into sheet code
Private Sub Worksheet_Activate()
activateCheckBoxes
End Sub
After that, I created a module and it was slightly adapted from the linked post:
' this code goes into a module
Option Explicit
Dim CheckBoxes() As New ChkClass
Sub doCheckBoxes()
makeCheckBoxes
activateCheckBoxes
End Sub
Sub makeCheckBoxes()
Sheets(2).Select
Dim c As Range
Dim ultlinha As Integer
ultlinha = Range("A2").End(xlDown).Row
Range(Cells(2, 9), Cells(ultlinha, 9)).Select
For Each c In Selection
With ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Left:=c.Left, Top:=c.Top, Width:=c.Width, Height:=c.Height)
DoEvents
.Object.Caption = "FATURADO"
.LinkedCell = c.Offset(0, 3).Address
.Object.Value = 0 'sets checkbox to false
.Object.Font.Name = "Calibri"
.Object.Font.Size = 9
.Object.Font.Italic = True
.Object.BackStyle = fmBackStyleTransparent
End With
Next
Range("a1").Select
End Sub
Sub activateCheckBoxes() ' assigns all checkBoxes on worksheet to ChkClass.ChkBoxGroup
Dim sht As Worksheet
Set sht = ActiveSheet
ReDim CheckBoxes(1 To 1)
Dim i As Integer
For i = 1 To sht.Shapes.Count
ReDim Preserve CheckBoxes(1 To i)
Set CheckBoxes(i).ChkBoxGroup = sht.Shapes(i).OLEFormat.Object.Object
Next i
End Sub
The problem lies in this line:
Set CheckBoxes(i).ChkBoxGroup = sht.Shapes(i).OLEFormat.Object.Object
If there is no other button or shape in the sheet, it runs correctly. If I add a single button or form to add the macro to it, it doesn't work.
If you only want to "activate" the checkboxes then you can loop over the sheet's OLEObjects collection and only capture the checkboxes.
Sub activateCheckBoxes()
Dim sht As Worksheet, obj As OLEObject, n As Long
Set sht = ActiveSheet
ReDim CheckBoxes(1 To 1)
Dim i As Integer
For Each obj In sht.OLEObjects
If TypeName(obj.Object) = "CheckBox" Then 'is a checkbox?
n = n + 1
If n > 1 Then ReDim Preserve CheckBoxes(1 To n)
Set CheckBoxes(n).ChkBoxGroup = obj.Object
End If
Next obj
End Sub
So I'm trying to use three Comboboxes to have a selection list for data input. I'm needing to make a selection in this order: Region -> Site -> Maintenance Plant. When a selection is made in the Region Combobox, then the Site Combobox list should filter to the options that pertain to the corresponding Region selection. Im thinking either a pivot table or vLookup needs to be used but I'm at a loss and have no clue how to get this done. Please help and thank you very much in advance.
Private Sub UserForm_Initialize()
Dim CreateBy As Range
Dim Region As Range
Dim Site As Range
Dim MaintPlant As Range
Dim Dept As Range
Dim Act As Range
Dim ImpActTyp As Range
Dim ValCat As Range
Dim ws As Worksheet
Set ws = Worksheets("LookupLists")
For Each CreateBy In ws.Range("RosterList")
With Me.CboCreateBy
.AddItem CreateBy.Value
End With
Next CreateBy
For Each Region In ws.Range("RegionList")
With Me.CboRegion
.AddItem Region.Value
End With
Next Region
For Each Site In ws.Range("SiteList")
With Me.CboSite
.AddItem Site.Value
End With
Next Site
For Each MaintPlant In ws.Range("MaintPlantList")
With Me.CboMntPlant
.AddItem MaintPlant.Value
End With
Next MaintPlant
For Each Dept In ws.Range("DeptList")
With Me.CboDept
.AddItem Dept.Value
End With
Next Dept
For Each Act In ws.Range("ActList")
With Me.CboAct
.AddItem Act.Value
End With
Next Act
For Each ImpActTyp In ws.Range("ImpActTypList")
With Me.CboImpActTyp
.AddItem ImpActTyp.Value
End With
Next ImpActTyp
For Each ValCat In ws.Range("ValCatList")
With Me.CboValCat
.AddItem ValCat.Value
End With
Next ValCat
Me.DateTextBox.Value = Format(Date, "Medium Date")
Me.PLife.Value = 0
Me.CSE.Value = 0
Me.CboRegion.SetFocus
End Sub
Get ready, because I'm about to reimagine your entire code here. I strongly recommend you create a backup of your original code module or workbook just due to the vast differences and if our ideas didn't align properly.
This will perform real-time filtering on your table, so keep this in mind using this method.
I did perform some testing on the following code, but I am human and threw this together in 20 mins or so. I wouldn't implement this in a real setting until you have fully tested the code and are comfortable with it.
And I just wanted to thank you for your use of Named Ranges. This made coding this easier.
You must enable the Microsoft Scripting Runtime library. This is used to grab the unique values from your tables. (Tools > References)
So to get things started, here is the entire code for your userform's code module:
Option Explicit
Private ws As Worksheet
Private tblLO As ListObject
Private Sub combo_region_Change()
Application.EnableEvents = False
Me.combo_maintPlant.Clear
Me.combo_site.Clear
'This is the first filter, so no worries about clearing entire AutoFilter
tblLO.AutoFilter.ShowAllData
Select Case Me.combo_region.Value
Case ""
Me.combo_site.Value = ""
Me.combo_maintPlant.Value = ""
Me.combo_site.Enabled = False
Me.combo_maintPlant.Enabled = False
Case Else
'If data is entered into first combobox, filter the table
tblLO.Range.AutoFilter 1, Me.combo_region.Value
'Populate the site combo box with new data
populateSiteCombo
'Enable the Site Combobox for user input
Me.combo_site.Enabled = True
End Select
Application.EnableEvents = True
End Sub
Private Sub combo_site_Change()
Application.EnableEvents = False
Me.combo_maintPlant.Clear
'Clear the filtering, then readd the Region's filter
tblLO.AutoFilter.ShowAllData
tblLO.Range.AutoFilter 1, Me.combo_region
Select Case Me.combo_site.Value
Case ""
Me.combo_maintPlant.Value = ""
Me.combo_maintPlant.Enabled = False
Case Else
'If data is entered into first combobox, filter the table
tblLO.Range.AutoFilter 2, Me.combo_site.Value
'Populate the Plant combo box with new data
populatePlantCombo
'Enable the Plant Combobox for user input
Me.combo_maintPlant.Enabled = True
End Select
Application.EnableEvents = True
End Sub
Private Sub populatePlantCombo()
'Grab unique values from Region column using Dictionary
Dim i As Long, regionDict As New Scripting.Dictionary
Dim arrReg() As Variant
'If it filters only 1 item, then it's just a single cell and not an arr
With ws.Range("MaintPlantList").SpecialCells(xlCellTypeVisible)
If .Count = 1 Then
Me.combo_maintPlant.AddItem .Value
Exit Sub
Else
arrReg = .Value
End If
End With
With New Scripting.Dictionary
For i = 1 To UBound(arrReg)
If Not .Exists(arrReg(i, 1)) Then
.Add arrReg(i, 1), "" 'We only add to dictionary for tracking
Me.combo_maintPlant.AddItem arrReg(i, 1)
End If
Next
End With
End Sub
Private Sub populateSiteCombo()
'Grab unique values from Region column using Dictionary
Dim i As Long, regionDict As New Scripting.Dictionary
Dim arrReg() As Variant
'If it filters only 1 item, then it's just a single cell and not an arr
With ws.Range("SiteList").SpecialCells(xlCellTypeVisible)
If .Count = 1 Then
Me.combo_site.AddItem .Value
Exit Sub
Else
arrReg = .Value
End If
End With
With New Scripting.Dictionary
For i = 1 To UBound(arrReg)
If Not .Exists(arrReg(i, 1)) Then
.Add arrReg(i, 1), "" 'We only add to dictionary for tracking
Me.combo_site.AddItem arrReg(i, 1)
End If
Next
End With
End Sub
Private Sub populateRegionCombo()
'Grab unique values from Region column using Dictionary
Dim i As Long, regionDict As New Scripting.Dictionary
Dim arrReg() As Variant
arrReg = ws.Range("RegionList").Value
With New Scripting.Dictionary
For i = 1 To UBound(arrReg)
If Not .Exists(arrReg(i, 1)) Then
.Add arrReg(i, 1), "" 'We only add to dictionary for tracking
Me.combo_region.AddItem arrReg(i, 1)
End If
Next
End With
End Sub
Private Sub UserForm_Initialize()
Set ws = ThisWorkbook.Worksheets("LookupLists") 'Module-defined var
Set tblLO = ws.ListObjects("Table1") 'Module-defined var
tblLO.AutoFilter.ShowAllData
Me.combo_maintPlant.Enabled = False
Me.combo_site.Enabled = False
'We only populate this one during init because the others
'will populate once a value is used in this box
populateRegionCombo
End Sub
If you decided to scroll down to understand what's going on here, then great.
Let's start with the initialization:
Private Sub UserForm_Initialize()
Set ws = ThisWorkbook.Worksheets("LookupLists") 'Module-defined var
Set tblLO = ws.ListObjects("Table1") 'Module-defined var
tblLO.AutoFilter.ShowAllData
Me.combo_maintPlant.Enabled = False
Me.combo_site.Enabled = False
'We only populate this one during init because the others
'will populate once a value is used in this box
populateRegionCombo
End Sub
We defined the module variables ws and tblLO. I'm not a huge fan of module-scoped variables, but we can usually get along when they are private vars to a userform module. Now the other functions in the code module can access these.
We reset autofiltering and disabled the two combo boxes that shouldn't be used until a selection is made for the region. Only after the region is selected will the next box be available for selection. We will handle these using Change Events for the comboboxes.
The userform is mostly controlled by the combo_region_change and combo_site_change events. Everytime region_change is fired, it will clear all the other combo boxes to redetermine it's new value. Then it will refilter as appropriately. The combo_site does the same, but it only clears the maintaince box. These event handlers also establish which of the other combox boxes are enabled depending on their values. So if you where to completely clear the site box for example, it will disable access to the Plant box again.
Finally you just have the "populate subs". Their jobs are simply to (re)populate the next combo box once the appropriate event handler is triggered.
Tip: If you feel the need to reset the filtering once you close your userform, you can just place the code to reset it in a UserForm_Terminate() event. It makes no difference to the above code if autofilter is enabled or not prior to it running, so that is preference only.
Why doesn't this code open the form with the items selected already? I set the selection flag to true with this code.
Private Sub UserForm_Initialize()
Dim i, InStrRes, k
With ActiveCell
If .Value <> "" Then
For i = 0 To Me.lstDV.ListCount - 1
InStrRes = InStr(1, ActiveCell.Value, Me.lstDV.List(i))
If InStrRes <> 0 And InStrRes <> Null Then
Me.lstDV.Selected(i) = True
End If
Next i
End If
End With
End Sub
Private Sub UserForm_Initialize()
Dim i, InStrRes, k
With ActiveCell
If .Value <> "" Then
For i = 0 To Me.lstDV.ListCount - 1
Me.lstDV.Selected(i) = False '<~~ add this code. Should be set to false in advance.
InStrRes = InStr(1, ActiveCell.Value, Me.lstDV.List(i))
'If InStrRes <> 0 And InStrRes <> Null Then
If InStrRes Then
Me.lstDV.Selected(i) = True
End If
Next i
End If
End With
End Sub
The presumption must be that the listbox hasn't been loaded at the time it is initialized. I tried the Activate event with similar lack of success. Please try this code instead.
Sub ShowMyForm()
Dim MyForm As New TryForm
Dim CellVal As Variant
CellVal = ActiveCell.Value
With MyForm
If Len(CellVal) Then
On Error Resume Next
.lstDV.ListIndex = Application.Match(CellVal, Range(.lstDV.RowSource), 0) - 1
End If
.Show
' code continues here when the form is closed
End With
Unload MyForm
End Sub
This code must be in a standard code module, not the form's code sheet. It calls the form TryForm (replace with the name you gave to your form), and modifies it before showing. Note that you still have full access to the form to take out values you may want after it is hidden. Just avoid Unload Me anywhere in the form's code because the unloading is done by the above code after you have taken everything you wanted.
Note that the form's Initialize event is triggered by the New key word in Dim MyForm As New TryForm, long before you gain access. The Activate event follows with some delay. Please make sure that the procedures you may run with these events don't interfere with what the above code does.
I have a listbox on a userform which has a sourcerange which I am trying to overwrite by providing values from a userform but as soon as I overwrite a particular cell the event ListBox1_Click() fires up which is undesirable as it repopulates the data on the userform.
Private Sub ListBox1_Click()
Application.EnableEvents = False
Dim i As Long, fRow As Long
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
If i > 0 Then
HSht.Range("cRow").Value = i + 1
fRow = HSht.Range("cRow").Value
Call getData(fRow)
HSht.Range("LRow").Value = getlastRow()
Me.ItemLbl.Caption = "Item number :" & HSht.Range("cRow").Value - 1 & " of " & HSht.Range("LRow").Value - 1
End If
Exit For
End If
Next i
Application.EnableEvents = True
End Sub
Here is the update button code:
Private Sub cmdUpdate_Click()
Application.EnableEvents = False
'Update
Dim fRow As Long, i As Long
fRow = HSht.Range("cRow").Value
Call updateData(fRow)
HSht.Range("LRow").Value = getlastRow()
Me.ItemLbl.Caption = "Item number :" & HSht.Range("cRow").Value - 1 & " of " & HSht.Range("LRow").Value - 1
'MsgBox "Data updated successfully"
Application.EnableEvents = True
End Sub
E.g let's you have 10 fields and you have ten textbox on a userform to view/modify the data but you also have multicolumn listbox to view and scroll the data in a table format, when I scroll up or down I get the specific rows data in the textboxes on userform, I also have a button which says "overwrite" in case I want to modify the data on the worksheet through userform. But as soon it modifies one cell in the worksheet the event "Listbox1_click" triggers and it overwrites the data on the userform.
Application.EnableEvents = false won't affect UserForms. You have to create a property and check it's value at event start and exit event sub if events disabled like:
' Top of UserForm-Class
Public EnableEvents As Boolean ' if Private code outside the userform can't change value.
'One should add a Letter/Getter to have more control over the property (exposing the variable that stores a property-value isn't recommended I think, with Get/Let we can perform checks or just make the Letter private, but the Getter public)
Private Sub UserForm_Initialize()
Me.EnableEvents = True
End Sub
Private Sub ListBox1_Click()
If Me.EnableEvents = False Then 'the first three lines of code suppress the events-code execution if EnableEvents = False and must be on top of every event that you want to have disabled.
Exit Sub
End If
'Me.EnableEvents = False should be set on top of button code and Me.EnableEvents = True at buttom if other events of from should be suppressed.
Dim i As Long, fRow As Long
For i = 0 To ListBox1.ListCount - 1
...
End Sub
Private Sub cmdUpdate_Click()
If Me.EnableEvents = False Then 'the first three lines of code suppress the events-code execution and must be on top of every event that you want to have disabled.
Exit Sub
End If
Me.EnableEvents = False 'disable Form-Events
... 'Button-Code
Me.EnableEvents = True 'reenable events
End Sub