I have a fully functioning userform that transfers values to a worksheet when hitting a 'Submit' button. This has worked fine when data validation was applied to all textboxes (a message box appears asking for a value to be entered), and with no data validation on the list box.
However, since adding in data validation for the list box (see code below), the 'Submit' button transfers only the pre-selected value in the form builder, rather than the selection. E.g. if nothing is selected by default, then I make a selection, it transfers an empty cell. If 'Alex' is selected by default and I select 'Hannah' once the form is open, it will transfer 'Alex'.
Does anyone have any ideas as to why the selected item in the list box isn't being picked up? All other values transfer fine (i have about 10 other textboxes with no issues). Is this an issue with the data validation?
My code looks like this:
Private Sub cbSubmit_Click()
'Name Selection Data Validation
If Not IsAnythingSelected(lbName) Then
MsgBox "Please select your name"
Exit Sub
End If
Unload Me
'Begin Transfer Information and Change Workbook
Dim nwb As Workbook
Set nwb = Workbooks.Open("G:\Test Dataset.xlsx")
'Determine emptyRow
Dim emptyRow As Long
emptyRow = WorksheetFunction.CountA(nwb.Sheets("daily_tracking_dataset").Range("A:A")) + 1
'Transfer Information
With nwb.Sheets("daily_tracking_dataset")
'Date
.Cells(emptyRow, 1).Value = CDate(txtDate.Text)
'Name
.Cells(emptyRow, 2).Value = lbName.Value
'Reference Checkss
.Cells(emptyRow, 3).Value = txtROT.Value
.Cells(emptyRow, 4).Value = txtROP.Value
End With
ActiveWorkbook.Save
ActiveWindow.Close
UserForm1.Hide
ActiveWindow.Close
End Sub
With the following function to determine if there is an item in the list box is selected:
'Function to loop through Name list box and find a selection
Function IsAnythingSelected(lbName As Control) As Boolean
Dim i As Long
Dim selected As Boolean
selected = False
For i = 1 To lbName.ListCount
If lbName.selected(i) Then
selected = True
Exit For
End If
Next i
IsAnythingSelected = selected
End Function
End If
ListBox indexing begins in 0 not 1. So use this instead in your function:
For i = 0 To lbName.ListCount - 1
If lbName.selected(i) Then
selected = True
Exit For
End If
Next I
Edit1:
Try replacing this line:
.Cells(emptyRow, 2).Value = lbName.Value
with this:
.Cells(emptyRow, 2).Value = lbName.List(lbname.ListIndex)
Related
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.
I have this code but it only work for my first row.
It is suppose to look if the checkbox on B, C or D is checked, and if so, a date + username will automaticaly fill in F and G.
here is a picture of my table:
This is what my code looks like:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("B2") Or Range("C2") Or Range("D2") = True Then
Range("G2").Value = Environ("Username")
Range("F2").Value = Date
Else
Range("F2:G2").ClearContents
End If
End Sub
Enter this code in a regular module, select all your checkboxes and right-click >> assign macro then choose ReviewRows.
This will run the check whenever a checkbox is clicked - a bit of overhead since all rows will be checked, but should not be a big deal.
Sub ReviewRows()
Dim n As Long
For n = 1 To 100 'for example
With Sheet1.Rows(n)
If Application.CountIf(.Cells(2).Resize(1, 3), "TRUE") > 0 Then
If Len(.Cells(6).Value) = 0 Then 'only enter if currently empty?
.Cells(6) = Date
.Cells(7) = Environ("Username")
End If
Else
.Cells(6).Resize(1, 2).ClearContents
End If
End With
Next n
End Sub
If you want to be more precise then Application.Caller will give you the name of the checkbox which was clicked, and you can use that to find the appropriate row to check via the linkedCell.
Sub ReviewRows()
Dim n As Long, shp As CheckBox, c As Range, ws As Worksheet
Set ws = ActiveSheet
On Error Resume Next 'ignore error in case calling object is not a checkbox
Set shp = ActiveSheet.CheckBoxes(Application.Caller) 'get the clicked checkbox
On Error GoTo 0 'stop ignoring errors
If Not shp Is Nothing Then 'got a checkbox ?
If shp.LinkedCell <> "" Then 'does it have a linked cell ?
With ws.Range(shp.LinkedCell).EntireRow
If Application.CountIf(.Cells(2).Resize(1, 3), "TRUE") > 0 Then
If Len(.Cells(6).Value) = 0 Then 'only enter if currently empty?
.Cells(6) = Date
.Cells(7) = Environ("Username")
End If
Else
.Cells(6).Resize(1, 2).ClearContents
End If
End With
End If 'has linked cell
End If 'was a checkbox
End Sub
However this appraoch is sensitive to the exact positioning of your checkbox
You have a long way to go!
Unfortunately, If Range("B2") Or Range("C2") Or Range("D2") = True Then is beyond repair. In fact, your entire concept is.
Start with the concept: Technically speaking, checkboxes aren't on the worksheet. They are on a layer that is superimposed over the worksheet. They don't cause a worksheet event, nor are they responding to worksheet events. The good thing is that they have their own.
If Range("B2") Or Range("C2") Or Range("D2") = True Then conflates Range with Range.Value. One is an object (the cell), the other one of the object's properties. So, to insert sense into your syntax it would have to read, like, If Range("B2").Value = True Or Range("C2").Value = True Or Range("D2").Value = True Then. However this won't work because the trigger is wrong. The Worksheet_Change event won't fire when when a checkbox changes a cell's value, and the SelectionChange event is far too common to let it run indiscriminately in the hope of sometimes being right (like the broken clock that shows the correct time twice a day).
The answer, therefore is to capture the checkbox's click event.
Private Sub CheckBox1_Click()
If CheckBox1.Value = vbTrue Then
MsgBox "Clicked"
End If
End Sub
Whatever you want to do when the checkbox is checked must be done where it now shows a MsgBox. You can also take action when it is being unchecked.
Entering data via a userform. After a few entries I can no longer see the active cell and I can't scroll the sheet while the userform is active. I would like to have the sheet auto-scroll to keep the active cell/row visible while I enter data on the userform.
I've tried adding some code I found online but they've all failed to get the result I'm looking for.
Private Sub Label1_Click()
End Sub
Private Sub Label2_Click()
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub TextBox2_AfterUpdate()
Dim emptyRow As Long
If TextBox1.Value <> "" And TextBox2.Value <> "" Then
With ThisWorkbook.Sheets("RO-BOX DETAILS")
emptyRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(emptyRow, 1).Value = TextBox1.Value
.Cells(emptyRow, 2).Value = TextBox2.Value
TextBox1.Value = ""
TextBox2.Value = ""
TextBox1.SetFocus
End With
End If
End Sub
Private Sub UserForm_Click()
End Sub
I'm not experienced with VBA. I honestly thought there would be a simple code snippet I could add in, but so far, no joy.
I scan into textbox 1 and it moves the focus to textbox 2
I scan into textbox 2 and it adds the data to the next empty row - no
clicking 'OK' required.
The focus returns to textbox 1.
Repeat
Now I just want it to keep the next empty row visible so I can see the entries go in on the fly. Basically to ensure they scanned correctly. Right now, I have to close the userform every so often and scroll down and look manually. PITA. :)
It won't quite achieve the autoscrolling you requested, but you could try calling the userform with it's ShowModal property set to "modeless". That would at least allow the user to manually scroll the sheet.
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/showmodal-property
...there's no example to follow on that page, but it would go something like...
sub CallNormsUserForm()
NormsUserForm.show vbModeless
end sub
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.
see codes below.
I have the 'beforesave' code in the Workbook module and it works fine when I'm in the active sheet. However from the table I use on sheet 2 I also have a pivot table on sheet 1. To refresh my pivot I use an inserted button with an attached macro (this is in the module section)
Sub Refresh_Pivot()
'
' Refresh_Pivot Macro
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveWorkbook.Save
End Sub
On Activate.Workbook.Save its starts to act on my other code (which is in the workbook module), I want this to happen as a pivot table with missing data is not a good tool. However on using this it defaults with an error and highlights the cell.Offset(0, 1).Select - How can I prevent this?
Ideally I want the user to select OK on the msgbox and then the screen page changes to Sheet 2 and highlights the offending cell.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim esave As Range
Dim psave As Range
Dim jsave As Range
Dim RAll As Range
Dim cell As Range
Set esave = Sheet2.Range("Table1[Estimated Claim (USD)]")
Set psave = Sheet2.Range("Table1[Provisional Claim (USD)]")
Set jsave = Sheet2.Range("Table1[Agreed Claim (USD)]")
Set RAll = Union(esave, psave, jsave)
For Each cell In RAll
If cell.Value <> "" And cell.Offset(0, 1).Value = "" Then
Dim missdata
missdata = MsgBox("Missing Data - Enter the Date for WorkBook to Save", vbOKOnly, "Missing Data")
Cancel = True
cell.Offset(0, 1).Select
Exit For
End If
Next cell
End Sub
.Select should be avoided.
INTERESTING READ
I also want to know why are you trying to select that cell? What is the purpose. If you want to interact with it, then you can do that without selecting it. For example
If cell.Value <> "" And cell.Offset(0, 1).Value = "" Then
Dim missdata
missdata = MsgBox("Missing Data - Enter the Date for WorkBook to Save", vbOKOnly, "Missing Data")
Cancel = True
With cell.Offset(0, 1)
'
''~~> Do something
'
End With
Exit For
End If
Having said that if you still want to select that cell then you need to be on that sheet. There are two ways now. One is like I mentioned in the comment above.
Add Sheet2.Activate just before For Each cell In RAll in the Workbook_BeforeSave event or do that in the button's click event.
Sub Refresh_Pivot()
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
Sheet2.Activate
ActiveWorkbook.Save
End Sub
Another point. You might want to pass Cancel = True before the Exit For to disable the save?