I am trying to populate my userform combobox with a list of part numbers after the user has selected the workstation on the previous user form.
My idea was to loop through the column, identify when the string matches the workstation and then add the cell in the column to the right (which turns out to be the product number)
My code looks like this so far:
If station = "MILL" Then
With ComboBox1
.AddItem "350SC109e.1"
.AddItem "350 SC166"
.AddItem "350 SC193"
.AddItem "350 SC195"
End With
End If
If station = "BRAKE" Then
For i = 2 To ws1.Range("A265").End(xlUp).Row
If ws1.Cells(i, 1) = "Brake" Then
ComboBox1.AddItem ws1.Cells(i, 2)
End If
Next i
End If
The MILL is an example of a manually doing the thing I want to accomplish with the loop in the BRAKE if statement.
Here i whipped this up real quick to demonstrate that I could get this to work in a loop. Youll have to adjust to fit your needs though. It did work flawlessly
Private Sub CommandButton1_Click()
Dim txtVal As String
If IsNull(TextBox1.Value) = False Then
txtVal = TextBox1.Value
Else
txtVal = ""
End If
Dim rng As Range
Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:A21")
Dim rcell As Range
For Each rcell In rng.Cells
If rcell.Value = txtVal Then
With ComboBox1
.AddItem rcell.Offset(0, 1).Value
End With
End If
Next rcell
End Sub
Related
Can anyone help me with a solution or a different method for this? I would like to edit the filtered listbox
I'm trying to get a listbox that is able to display my sheet1 and be able to filter all the blanks/not found in column A. I also want to be able to edit the listbox aswell
I would like my userform2 listbox to display the sheet1 information.
There will also be a checkbox which will filter the listbox to show “not found” or blank lines.
If i double click the selected item on the listbox i would like to edit the information
for userform2
Private Sub ListBox2_Click()
TextBox1.Enabled = True
TextBox1.Value = ListBox2.Value
End Sub
Private Sub TextBox1_Change()
Dim rCell As Range
With ListBox2
Set rCell = Range(.RowSource).Resize(1).Offset(.ListIndex)
rCell.Value = TextBox1.Value
End With
End Sub
Private Sub CheckBox1_Click()
OptimizedMode True
If userform2.CheckBox1.Value = True Then
Worksheets("Table").Range("A1").AutoFilter Field:=1, Criteria1:="Not Found", Operator:=xlOr, Criteria2:="="
userform2.ListBox2.RowSource = vbNullString
userform2.ListBox2.ColumnHeads = False
Dim rng As Range
Dim Cel1 As Range
Dim LR As Long
Dim ws As Worksheet
Set ws = Sheets("Table")
With ws
LR = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A2:A" & LR).SpecialCells(xlCellTypeVisible)
With userform2.ListBox2
.ColumnCount = 1
For Each Cel1 In rng
.AddItem CStr(Cel1.Value)
.List(.ListCount - 1, 1) = Cel1.Offset(0, 1).Value
Next Cel1
End With
End With
End If
If CheckBox1.Value = False Then
With userform2.ListBox2
.RowSource = "Table!A2:A1048576"
End With
End If
OptimizedMode False
End Sub
I've re-designed my code and I believe this will achieve what you are after.
NOTE: This code uses all default object names. You will need to modify it to target the names for your workbook, sheet, useform, controls etc, if you wish to implement into your project.
In designing this answer I used the following:
A new blank Workbook with 1 new Worksheet
A new UserForm (captioned "ListBox Editor") with 1 ListBox that has 2 columns (ColumnCount = 2) and 1 CheckBox (captioned "Show Blanks").
The sample data I used was in Range("A1:A10") filling only odd numbers from row 1. This allows testing for including/excluding blank/empty rows. Screenshots of the Worksheet and UserForm below.
Worksheet data:
UserForms both with and without blanks in the listbox:
All code is written in the code behind module for the UserForm
Most can be written into any other module with calls made to the subs/functions from the UserForm/ListBox events if you'd prefer not to have the working code in the UserForm module.
Code blocks with explanations below (full code block at the end for copy/paste):
Option Explicit
Option Explicit should be included at the top of each and every code module you use. It forces explicit declaration of all variables which helps significantly in avoiding typo's in your code etc.
Private Sub PopulateListBox(ByVal IncludeBlanks As Boolean)
Dim TargetCell As Range
Dim TargetWorksheet As Worksheet
Set TargetWorksheet = ThisWorkbook.Sheets("Sheet1")
With UserForm1.ListBox1
.Clear
For Each TargetCell In TargetWorksheet.Range("A1:A10")
If Not IncludeBlanks Then
If Not TargetCell.Value = "" Then
.AddItem TargetCell.Value
.List(.ListCount - 1, 1) = TargetCell.Row
End If
ElseIf IncludeBlanks Then
.AddItem TargetCell.Value
.List(.ListCount - 1, 1) = TargetCell.Row
End If
Next TargetCell
.ColumnWidths = ";0" 'Hides listbox column that holds row number
End With
End Sub
PopulateListBox is a subroutine I wrote to handle population of the items in the ListBox. It first clears the list, allowing each population of the listbox to be 'refreshed' data. Then it iterates through each TargetCell of the defined Range. If IncludeBlanks is True it has no conditions to meet and adds each cell value into the list, if IncludeBlanks is False it will only add the cell value to the list if the value is not "".
Private Sub CheckBox1_Click()
If Me.CheckBox1.Value = False Then
PopulateListBox False
ElseIf Me.CheckBox1.Value = True Then
PopulateListBox True
End If
End Sub
This _Click event simply updates the ListBox list based on if the CheckBox is checked or not. The CheckBox represents if you are including blanks/empty cells or not so it passes True or False respective to it's Value, to the IncludeBlanks argument in PopulateListBox.
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim NewValue As Variant
Dim TargetWorksheet As Worksheet
Set TargetWorksheet = ThisWorkbook.Sheets("Sheet1")
NewValue = InputBox("What is the new value to replace " & UserForm1.ListBox1 & "?")
If Not StrPtr(NewValue) = 0 Then 'Check user did NOT click cancel or [X]
With ListBox1
If NewValue = "" Then NewValue = vbNullString
TargetWorksheet.Cells(.List(.ListIndex, 1), 1).Value = NewValue
.AddItem NewValue, .ListIndex
.RemoveItem .ListIndex
End With
End If
End Sub
The _DblClick Event triggers the code when a list item is double clicked. This code first opens an InputBox to allow the user to enter a new value for the selected listbox item. When the user clicks OK or hit's Enter, the new value is first written to the Cell that the original value came from, then the new value is added as a new list item and finally the previous value is removed. If the user clicks [X] or 'Cancel' the code does nothing.
Private Sub UserForm_Initialize()
PopulateListBox False
End Sub
Much the same as the Checkbox_Change code, this simply populates the ListBox when the UserForm is first initialized. It's written to exclude blanks, specified by False for the IncludeBlanks argument.
Put it all together and you have:
Option Explicit
Private Sub CheckBox1_Click()
If Me.CheckBox1.Value = False Then
PopulateListBox False
ElseIf Me.CheckBox1.Value = True Then
PopulateListBox True
End If
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim NewValue As Variant
Dim TargetWorksheet As Worksheet
Set TargetWorksheet = ThisWorkbook.Sheets("Sheet1")
NewValue = InputBox("What is the new value to replace " & UserForm1.ListBox1 & "?")
If Not StrPtr(NewValue) = 0 Then 'Check user did NOT click cancel or [X]
With ListBox1
If NewValue = "" Then NewValue = vbNullString
TargetWorksheet.Cells(.List(.ListIndex, 1), 1).Value = NewValue
.AddItem NewValue, .ListIndex
.RemoveItem .ListIndex
End With
End If
End Sub
Private Sub UserForm_Initialize()
PopulateListBox False
End Sub
Private Sub PopulateListBox(ByVal IncludeBlanks As Boolean)
Dim TargetCell As Range
Dim TargetWorksheet As Worksheet
Set TargetWorksheet = ThisWorkbook.Sheets("Sheet1")
With UserForm1.ListBox1
.Clear
For Each TargetCell In Range("A1:A10")
If Not IncludeBlanks Then
If Not TargetCell.Value = "" Then
.AddItem TargetCell.Value
.List(.ListCount - 1, 1) = TargetCell.Row
End If
ElseIf IncludeBlanks Then
.AddItem TargetCell.Value
.List(.ListCount - 1, 1) = TargetCell.Row
End If
Next TargetCell
.ColumnWidths = ";0"
End With
End Sub
I am trying to create a tool with a userform where the user types a Model in a textbox and selects all the countries where this Model comes from in 10 possible checkboxes.
This information is transferred to "Country" Worksheet through command button.
My code places textbox value in column A and country name from checkbox label in column B.
The problem is that I have more than one country for the same model so I'm getting blank cells without matching Model.
E.g. "Type A" belongs to USA, Brazil, Sweden and Mexico, so I should have "Type A" copied four times along country names instead of just one.
Private sub Transfer()
Dim i As Long
Dim aCol As Range
Dim BS As Worksheet
Set aCol = Worksheets("Country").Range("A:A")
Set BS = Worksheets("Country")
For i = 1 To 10
With Me.Controls("CheckBox" & i)
If .Value Then
aCol.Cells(82, 2).End(xlUp).Offset(1, 0).Value = .Caption
End If
End With
Next i
Dim b As Integer
b = 1
Do Until BS.Range("A" & b).Value = ""
b = b + 1
end sub
With the code you shared and without major changes, I would suggest you to think about writing the info contained in the textbox within the loop of the checkboxes and right after the if. This way you will be adding the textbox text no matter what avoiding the blanks
If .Value Then
aCol.Cells(82, 1).End(xlUp).Offset(1, 0).Value = Me.Controls("TextBox1").Text
aCol.Cells(82, 2).End(xlUp).Offset(1, 0).Value = .Caption
End If
Let me know if that works, below the full code I used to replicate your issue:
Private Sub CommandButton1_Click()
Call Transfer
End Sub
Private Sub Transfer()
Dim i As Long
Dim aCol As Range
Dim BS As Worksheet
Set aCol = Worksheets("Country").Range("A:A")
Set BS = Worksheets("Country")
For i = 1 To 3
With Me.Controls("CheckBox" & i)
If .Value Then
aCol.Cells(82, 1).End(xlUp).Offset(1, 0).Value = Me.Controls("TextBox1").Text
aCol.Cells(82, 2).End(xlUp).Offset(1, 0).Value = .Caption
End If
End With
Next i
End Sub
How the form I did looks in VBA
How the results look like in the file
So i'm very new to coding and want to learn how can i filter a listbox based on selection on 2 comboboxes. So what i want to do is when VBA initializes the entire range displays on the listbox and when 1 combobox is selected it filters down the range and when the second combobox is selected it filters down even more and both comboboxes can be used individually. but i couldnt find anything online either for VBA excel or something similar.
Private Sub ComboBox1_Change()
Dim Database(1 To 100, 1 To 4)
Dim my_range As Integer
Dim colum As Byte
On Error Resume Next
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("MASTER")
sh.Range("G5").AutoFilter Field:=7, Criteria1:=Me.ComboBox1.Value
For i = 5 To sh.Range("G100000").End(xlUp).Row
If sh.Cells(i, 1) = Me.ComboBox1 Then
my_range = my_range + 1
For colum = 1 To 5
Database(my_range, colum) = sh.Cells(i, colum)
Next colum
End If
Next i
Me.ListBox1.List = Database
End Sub
Private Sub UserForm_Initialize()
With Me.ComboBox1
.Clear
.AddItem ""
.AddItem "L461"
.AddItem "L462"
.AddItem "L463"
.AddItem "L464"
.AddItem "L465"
End With
End Sub
I am new ti VBA and i would like to perform a function as follows i hope someone could help me out
I need to set a macro that starts at Cell A2 when i click my function a dialog box appears which i can enter relevant information into and it inserts into the relevant cells
inserts data into 3 fields (B2, C2, D2)
then selects B3 where i can press my button again to do the same thins again
heres my code so far
Dim StartCell As Integer
Private Sub Cancel_Click()
Unload GarageDimensions
End Sub
Private Sub LengthBox_Change()
If LengthBox.Value >= 15 Then
MsgBox "Are you sure? You do realise it is just a garage!"
Exit Sub
End If
End Sub
Private Sub Submit_Click()
'This code tells the text entered into the job reference textbox to be inserted _
into the first cell in the job reference column.
StartCell = Cells(1, 2)
Sheets("Data").Activate
If IsBlankStartCell Then
ActiveCell(1, 1) = JobRef.Text
ActiveCell.Offset(0, 1).Select
ActiveCell(1, 1) = LengthBox.Value
ActiveCell.Offset(0, 1).Select
ActiveCell(1, 1) = ListBox1.Value
ActiveCell.Offset(0, 1).Select
ActiveCell(1, 1) = ListBox1.Value * LengthBox.Value
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
Unload GarageDimensions
End Sub
Private Sub UserForm_Initialize()
With ListBox1
.AddItem "2.2"
.AddItem "2.8"
.AddItem "3.4"
End With
ListBox1.ListIndex = 0
End Sub
Thanks for your answers in advance
Adam
You don't need the Private Sub LengthBox_Change() event. You can set the MAX characters of the TextBox LengthBox either in the Design Mode or in the UserForm_Initialize() event as I have done below.
Also if you hard-code the Startcell then every time you run the UserForm the data will start from A2 and if there is any data there, then that will be overwritten. Instead try and find the last available row where you can write.
BTW, is this what you are trying (UNTESTED)?
Option Explicit
Dim StartCell As Integer
Dim ws As Worksheet
Private Sub UserForm_Initialize()
Set ws = Sheets("Data")
With ListBox1
.AddItem "2.2"
.AddItem "2.8"
.AddItem "3.4"
.ListIndex = 0
End With
LengthBox.MaxLength = 14
End Sub
Private Sub Submit_Click()
With ws
'~~> Find the first empty row to write
StartCell = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & StartCell).Value = Val(Trim(ListBox1.Value)) _
* Val(Trim(LengthBox.Value))
.Range("B" & StartCell).Value = JobRef.Text
.Range("C" & StartCell).Value = LengthBox.Value
.Range("D" & StartCell).Value = ListBox1.Value
End With
Unload Me
End Sub
Private Sub Cancel_Click()
Set ws = Nothing
Unload Me
End Sub
hope u're well. Need an expert help after trying a lot without sucess, please.
I have a price list in Sheet1 with 3 columns:
Medical Procedure
Type
Value of Procedure
In a userform, I need to return in Textbox1 the value of the procedure based on the criteria selected in combobox1 (with values that can be found in Medical Procedure column in Sheet1) and the caption in label1 (wich alrealdy is populated with a value that can be encounter in the Type column in Sheet1).
I tried this found here in stackoverflow from the user B Hart (thanks, B Hart!), but I wasn't able to change it to return in a textbox as a numerical value (this vba insert the found value in a listbox instead). Another issue is that the criteria below is in two combobox. I need the two criterias to be in a combobox and another in a label.
Private Sub GetCondStrandValue()
Dim iRow As Long
Dim strValue As String
strValue = vbNullString
If Me.ComboBox1.Value = vbNullString Or Me.ComboBox2.Value = vbNullString Then Exit Sub
With Planilha1
For iRow = 2 To .Range("A65536").End(xlUp).Row
If StrComp(.Cells(iRow, 1).Value, Me.ComboBox1.Value, 1) = 0 And _
StrComp(.Cells(iRow, 2).Value, Me.ComboBox2.Value, 1) = 0 Then
strValue = .Cells(iRow, 3).Value
Exit For
End If
Next
End With
If strValue = vbNullString Then Exit Sub
With Me.ListBox1
'If you only want a single value in the listbox un-comment the .clear line
'Otherwise, values will continue to be added
'.Clear
.AddItem strValue
.Value = strValue
.SetFocus
End With
End Sub
Maybe something like this:
Private Sub combobox1_Change()
Dim lastRow As Integer
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Me
For r = 2 To lastRow
If Sheets("Sheet1").Cells(r, 1) = .ComboBox1.Value And Sheets("Sheet1").Cells(r, 2) = .Label1.Caption Then
.TextBox1.Text = Sheets("Sheet1").Cells(r, 3)
Exit For
End If
Next
End With
End Sub