In my UserForm is a ComboBox, this ComboBox shows a list with more than 100 values. If I start typing some letters into the ComboBox I want that the dropdown-list will automatically only shows the values which has the typed letters (this works fine so far). But if I choose one value the ComboBox will stay empty.
Here is my code for the ComboBox:
Private Sub ComboBox1_Change()
Worksheets("DataSheet").Range("B1").Value = dbCustomer.Value
dbCustomer.RowSource = "=ddCustomer" 'Named Range
End Sub
In my Worksheet "DataSheet" in column "D" I wrote the formula:
=IFERROR(INDEX(Customer;AGGREGAT(15;6;(ROW(Customer)-1)/(--(SEARCH($B$1;Customer)>0));ZEILE()-1);1);"")
The named range "ddCustomer" I saved with:
=DataSheet!$D$2:INDEX(DataSheet!$D$2:$D$105;COUNTIF(DataSheet!$D$2:$D$105;"?*"))
What do I have to change, that the value which I choose will shown in the ComboBox?
EDIT
Could find a solution, maybe it is not perfect but it works fine for me.
Private Sub dbCustomer_Change()
Dim customer As Object
Set customerValue = Worksheets("DataSheet").Range("C2:C479").Find(dbCustomer.Value, LookIn:=xlValues, LookAt:=xlWhole)
If customerValue Is Nothing Then
dbCustomer.Clear
GoTo FillDB
Else
Worksheets("DataSheet").Range("B1").Value = ""
Exit Sub
End If
FillDB:
Worksheets("DataSheet").Range("B1").Value = dbCustomer.Value
For Each customer In Worksheets("DataSheet").Range("D2:D479")
If customer <> "" Then
dbCustomer.AddItem customer.Value
End If
Next
End Sub
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 need to create check box to be checked only if another specific cell contains specific input and unchecked if this input is not existing, noting that i tried below code
Private Sub Worksheet_Ca()
Dim DestS As Worksheet
Set DestS = ThisWorkbook.Worksheets("rest")
Dim DestSh As Range
Set DestSh = DestS.Range("B2")
If DestSh.Value = "Device" Then
DestS.CheckBoxes("Reset").Value = xlOn
Else
DestS.CheckBoxes("Reset").Value = xlOff
End If
End Sub
Also the check box i used is part of the forms toolbar not activeX and i changed the name of the check box to 'reset'
The error i got using debug is
method of checkbox of object _worksheet failed
Please, copy the next event code in the worksheet "rest" code module:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
If Target.value = "Device" Then
CheckBoxes("Reset").value = True
Else
CheckBoxes("Reset").value = False
End If
End If
End Sub
When you change the "B2" cell value in "Device", the check box will be checked. If you change its value in something else, the check box will be unchecked...
In order to copy the code in that sheet module, please activate sheet "rest" execute right click on the sheet name, choose View Code and copy the above code in the window which opens...
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.
I'm having problem with a user form returning lookup values in a textbox based on the value from a drop-down list within the form. If I select an item from a list, taken from a table within the workbook, I would like a textbox in the same form to return the reference number for the item selected.
I'm using the following code:
With TestNameFuntionBox
Dim rngOWASPControls As Range
Dim ws As Worksheet
Set ws = Worksheets("List")
For Each rngOWASPControls In ws.Range("A2:D80")
Me.TestNameFunctionBox.AddItem rngOWASPControls.Value
Next rngOWASPControls
End With
It seems as though whilst the drop-down list is available in the form to select, the value returned is not being picked up for the lookup as the lookup textbox remains blank.
I've tried to enter one entry which exists in the table such as the following:
TestNameValueFunctionBox.Value = "Review Webserver"
The Lookup textbox works absolutely fine and populates the value required. I'm using the following VBA code for the reference textbox:
With OWASPRefBox
If TestNameValueFunctionBox.Value <> "" Then
OWASPRefBox.Value = Application.VLookup(TestNameValueFunctionBox.value, Worksheets("List").Range("A2:D80"), 3, FALSE)
End If
End With
I hope I've explained it well enough!
This works fine for me:
Private Sub UserForm_Initialize()
With TestNameFuntionBox
Dim rngOWASPControls As Range
Dim ws As Worksheet
Set ws = Worksheets("List")
For Each rngOWASPControls In ws.Range("A2:A80")
If rngOWASPControls <> "" Then
Me.TestNameFunctionBox.AddItem rngOWASPControls.Value
End If
Next rngOWASPControls
End With
End Sub
Private Sub TestNameFunctionBox_Change()
If TestNameFunctionBox.Value <> "" Then
OWASPRefBox.Value = Application.VLookup(TestNameFunctionBox.Value, Worksheets("List").Range("A2:D80"), 3, False)
End If
End Sub
Sample Data:
Userform at initialize:
Selecting "Cat" returns the value in column 3:
I am relatively new to VBA and am learning on the fly. I am adapting code from another project to fit my needs and am having an issue.
I have a userform that has a combox box that is populated by an advanced filter. I need to use this filter in the next row of data so I am trying to clear the rowsource of the combobox but leave the selected value.
Everything in the ASales1_Change code works as expected. I get a list for that combobox and the second combobox like I want. But I need to clear out the row source from ASales2 in order to add information to the second row
Here is the code I have for the boxes in the first row of the sales order frame of the user form.
Private Sub ASales1_Change()
On Error Resume Next
Sheets("Products").Range("L4").Value = ASales1.Value
'run advanced filter to change productlist named range
Adv
'clear values for product and quantity
For X = 2 To 3
Me.Controls("ASales" & X).Value = ""
Next
'set productlist as rowsource for second control
Me.ASales2.RowSource = "ProductList"
On Error GoTo 0
End Sub
Private Sub ASales3_Change()
On Error Resume Next
Me.ASales2.RowSource = ""
On Error GoTo 0
End Sub
Image of userform set up
You can accomplish this by storing the selected Value of ASales2 in a String variable, see code below:
Private Sub ASales3_Change()
On Error Resume Next
Dim ASales2_Selected as String
ASales2_Selected = ASales2.Value
ASales2.RowSource = ""
ASales2.AddItem ASales2_Selected 'so the Item is added to the ComboBox
ASales2.Value = ASales2_Selected 'To show the value in the ComboBox
On Error GoTo 0
End Sub