Filling a combobox with values in VBA - excel

I am having trouble filling a combobox with options from a range.
The user selects the range with a refedit, the ComboBox must then be populated with the values of the selected cells. If the user changes the ref the old data must be removed and repopulated with the new data.
Below is my current code. Compiles right, but doesn't work.
I'm not attached to a ComboBox per se, but I need to populate a list with the values from a column so the user can select the one they want to use as "key" The first set is a sample of what is in a row. I would want these options offered as the choices for the dropdown.
You can download a copy of what I'm working on at http://ge.tt/2dbV5Yt/v/0?c
Store # Address City ST Zip Market Radius
Private Sub rngHeader_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim selRng As Range
Set selRng = Range(rngHeader.Value)
'//Erase any items that are in there
For I = 1 To cmbKeyCol.ListCount
cmbKeyCol.RemoveItem 0 'Remove the top item each time
Next I
'Below here is the part that I'm having trouble with. This is one of my attempts, but
'I've changed this thing probably 20 times since asking the question
'//Build new list of items from the header row.
For Each cell In selRng.Cells
cmbKeyCol.AddItem cell.Value
Next
End Sub

why don't you use this instead:
cmbkeyCol.RowSource = selRng.Address 'Assuming you already got your range right.
This adds all the items in the range specified instead of iterating through them 1 by 1.
Edit 1:
Dim list as variant
list = selRng.Value
list = Application.Transpose(list)
cmbkeyCol.List = list
Hope this works.
Edit 2:
Dim list as variant
list = rngHeader.value
list = Application.Transpose(list)
cmbkeyCol.List = list
I assumed that selRng is the source range in Edit 1 well in fact it is rngHeader.
Hopefully this works now.

Related

How to remove item from combobox in a userform?

I have a list of names in a sheet. I set these names as my RowSource for a combobox on a useform.
There are two Comboboxes involved. One starts full, the other starts empty.
I want when I click on a name from the first (full) combobox, said name to be added to the other combobox, and removed from the original combobox (and vice versa eventually).
I can't remove anything with RemoveItem.
I went the 'Menu.ListeAjoutAg.ListIndex' way to get my current selection's index ('Menu' is the UserForm and 'ListeAjoutAg' is the combobox), but it did not work.
Tried inputting through a variable I created real quick, 'b', but same result. No index number works. I checked and I only feed the function integers (0, 1, 3, 4...) that are correct and/or well within the scope of my list (about 45 names).
Private Sub ListeAjoutAg_Change()
a = Menu.ListeAjoutAg.Text
b = Menu.ListeAjoutAg.ListIndex
Menu.ListeRetirer.AddItem (a) ' goes fine till there
Menu.ListeAjoutAg.RemoveItem (b) 'and here it goes wrong
Menu.ListeRetirer.Enabled = True
Menu.ListeRetirer.Visible = True
End Sub
As already mentioned: You can't add or remove items from a Listbox if you have set the Rowsource property.
However, it is rather easy to fill a Listbox from a range - simply copy the cell values into an array and assign the array as List. See for example VBA Excel Populate ListBox with multiple columns
Put the following routine into your form and call it from the form Activate event.
Private Sub fillListBox(r As Range)
Me.ListeAjoutAg.Clear
Me.ListeAjoutAg.ColumnCount = r.Columns.Count
Dim data
data = r.Value
Me.ListeAjoutAg.List = data
End Sub
Private Sub UserForm_Activate()
Dim r As Range
' Replace this with the range where your data is stored.
Set r = ThisWorkbook.Sheets(1).Range("A2:C10")
fillListBox r
End Sub

Create dependent drop lists (using data validation or combo box) with auto refresh

I want to create many dependent drop list (more than 100) that auto refresh when the source list changes.
I am able to auto update the list using data validation and by changing the source list using named ranges but the selected item doesn't change unless I re-select the data validation list.
lets take as a simplified example the following:
category_List:
colors = {black, red, green}
languages = {english, french, spanish}
So if i select colors, i want to display the colors list and if I select the languages then I want to select the languages list. If red was selected then when i change to languages category, I want the french to be automatically selected and so on.
I am aware of two solutions:
1) https://www.youtube.com/watch?v=wWasYHG1lmM&list=PLmHVyfmcRKywYhC1Q9eZqR7D-_cdiwl6y&index=12
Uses VBA to do that, but since I have more than 100 list and the dependent list are random then I have to manually change each list when a specific source list changed. I dont think this the best idea.
2)https://www.youtube.com/watch?v=aSPtWo3IiOM&list=PLmHVyfmcRKywYhC1Q9eZqR7D-_cdiwl6y&index=11
A better approach as this will automatically change the selection when the category changes and it also give an additional feature which is the linked cell that gives a bi-directional connection between the cell and the combo box.
But my issue is that linked cell returns a 1-based index and I want that to be 0-based index. So if I select the first element, I want the linked cell to display 0 not 1 and vice versa...
Is there a way to achieve what I want easily ? either using one of the proposed approach or using another one ?
thanks
If I understand your question correct, you want something like this.
Create 2 comboboxes on your sheet.
In VBA make the following code:
Sub PopulateComboBox_Category()
Dim N As Long, i As Long
With Blad1
N = .Cells(1, Columns.Count).End(xlToLeft).Column
End With
With Blad1.ComboBox2
.Clear
For i = 1 To N
.AddItem Blad1.Cells(1, i).Value
Next i
End With
End Sub
Sub PopulateCombobox()
Dim Targetcell As Range
Dim strCategory As String
strCategory = Blad1.ComboBox2.Value
Set Targetcell = Range("1:1").Find(What:=strCategory)
Dim col As Long
col = Targetcell.Column
Dim N As Long, i As Long
With Blad1
N = .Cells(Rows.Count, col).End(xlUp).Row
End With
With Blad1.ComboBox1
.Clear
For i = 2 To N
.AddItem Blad1.Cells(i, col).Value
Next i
End With
End Sub
Make a change event on the sheet with the following code.
Private Sub ComboBox2_Change()
Call PopulateCombobox
End Sub

How to use data validation to restrict selection to a list with all unique entries in a column and one additional?

I want to do the following: I have a table = Listobject which has a column called MasterID. Some columns have the same MasterID and some have even non. I need to manually add the missing MasterIDs.
I want take a row where the MasterID is empty and then I want to click on the column MasterID and select an ID for this column. It can either be an existing ID. Which is the unique lsit of used MasterIDs in the hole listcolumn OR it can be a new MasterID. If a new ID is selected it should be the next integer from the biggest MasterID. So if the highest masterID up until now was 1000 then the new one should be 1001.
So I wanted to know if there is a way to use data validation in order to suggest me the next bigger MasterID or all existing. Since the already filled MasterIDs are randomly distributed I need to make this into a single formula.
Lets formulize this a little:
IF the cell is NOT EMPTY it can be whatever it wants to be, ELSE the cell needs to be one of the values used in the listcolumn OR the MAXIMUM of the Listcolumn +1.
If possible I would like to use a dropdown list.
I have tried this with a data validation list option but I couldn't figure out how. I know there needs to be a structur like this:
If Isempty then BeWhatever
Else Be DynamicAdjustedListofEntries OR MaximumEntry+1
I have thought of doing this with a macro but I don't want to update this everytime I change something. Can anyone help?
I don't think dynamically filling up the list type of validation is possible using pure Excel. Here's my solution using VBA. Place this macro in the appropriate worksheet:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = Range("Table26[MasterIDs]").Column Then
Dynamic_Data_Validation "Table26[MasterIDs]"
End If
Application.EnableEvents = True
End Sub
Note: Change Table26[MasterIDs] according to your data.
Then paste this in a normal module. You can, of course, paste these lines directly into the Worksheet_Change procedure.
Sub Dynamic_Data_Validation(table_range As String)
Dim ids() As Variant 'Didn't declare as Long because JOIN function doesn't accept it
Dim row_count As Long
Dim src As Range, tmp_rng As Range
Dim validation_list As String
Application.ScreenUpdating = False
Set src = Range(table_range)
ids = src.Value
'Change X to some other column name if you don't prefer this
Set tmp_rng = Range("X1").Resize(UBound(ids))
tmp_rng = ids
'If sorted in descending order, it becomes difficult to add the
'(MAX + 1) ID in the beginning of the array
tmp_rng.Sort Key1:=tmp_rng, Order1:=xlAscending
tmp_rng.RemoveDuplicates Columns:=1
row_count = tmp_rng.End(xlDown).Row
'Add the (MAX + 1) ID to the end of the range and resize it
tmp_rng.Cells(row_count + 1).Value = tmp_rng.Cells(row_count).Value + 1
Set tmp_rng = tmp_rng.Resize(row_count + 1)
tmp_rng.Sort Key1:=tmp_rng, Order1:=xlDescending
ids = Application.Transpose(tmp_rng)
tmp_rng.Delete Shift:=xlToLeft
'Perhaps consider adding a code to save the workbook after this line,
'as pressing CTRL + END will move the cursor to column X or whatever you choose
validation_list = Join(ids, ",")
'The existing validation needs to be deleted, otherwise it raises error
src.Validation.Delete
src.Validation.Add Type:=xlValidateList, Formula1:=validation_list
End Sub
I've used the worksheet to place the array items temporarily for sorting and removal of duplicates, because this seemed easier. An alternative is to manipulate the array elements within the array itself and then passing it as an argument to VBA.Join.
Here's the output:

How to fill a combobox with a dataset that matches a specific date

I am creating a userform in Excel that allows the user to review all records that were entered on a selected date. The date is selected using a combobox populated with dates from the current week. Then all other actions are triggered by a command button.
I am trying to figure out how to populate the review combobox and/or review listbox with all data from the named range that matches the selected date. Any help is appreciated. The following code includes a Vlookup command that is a deadend.
worksheet: Data_Entry
named range: Records_Entered
userform: ufrmDataEntry1
date combobox: CboReviewWeek
command button: CmdReviewCount
review combobox: CboReviewRecords
review listbox: LstReviewRecords
Private Sub UserForm_Initialize()
'fill combobox
Me.CboReviewWeek.List=[index(Text(today()-weekday(today(),2)+row(1:7),"mm/dd/yyyy"),)]
End Sub
Private Sub CmdReviewCount_Click()
'Step 1) pass selection of CboReviewWeek to "Formulas" sheet
ActiveWorkbook.Sheets("Formulas").Range("A4") = Me.CboReviewWeek
'Step 2) Return count of total records entered on selected date
Me.TxtReviewCount = ActiveWorkbook.Sheets("Formulas").Range("A5")
'Step 3) Return records entered to listbox
var1 = WorksheetFunction.VLookup(CboReviewWeek.Value, Worksheets("Data_Entry").Range("Records_Entered"), 2, False)
LstReviewRecords.Value = var1
CboReviewRecords.Value = var1
'Me.LstReviewRecords.List = ActiveWorkbook.Sheets("Data Entry").Range("Records_Entered")
'Is broke here
End Sub
There are several ways to get the results you wish. The solution may depend upon two issues you didn't mention -- whether you're storing just dates or datetimes, and whether your data is sorted by the date entered or is in some other order. The latter is critical -- if the data is sorted by the date it was entered, then the group of records you're looking for is contiguous. If not, then they will be scattered through your worksheet.
Assuming your records are in order, you simply need to find the start and end rows. I am assuming that the date you are looking for in the Records_Entered range is in the first column -- if not, you'll need to change the "1"'s in the code to match.
Dim R as Range, NumRows as integer
NumRows=Worksheets("Data_Entry").Range("Records_Entered").Rows.Count
Set R=Worksheets("Data_Entry").Range("Records_Entered").Columns(1).Find(What:=CboReviewWeek.Value, after:=Worksheets("Data_Entry").Cells(NumRows,1))
Do While R.value=CboReviewWeek.Value
CboReviewReviewRecords.addItem R.value (Or, if you want to return the second column like in your VLOOKUP above, use R.offset(0,1).value)
Set R=R.offset(1,0)
Loop
The "after" attribute in the find is needed because, unfortunately, Excel starts the search with the first cell and only looks at cells after it -- i.e. if the date selected is actually the first date in the range, the find will result in the second row. By starting the search in the last row, it forces Excel to wrap to the the first row to start the search.
If the records are not sorted in order, or if you just want a more flexible solution, you could use FindNext instead:
Dim R as Range, NumRows as integer, FirstCell as Range
NumRows=Worksheets("Data_Entry").Range("Records_Entered").Rows.Count
Set R=Worksheets("Data_Entry").Range("Records_Entered").Columns(1).Find(What:=CboReviewWeek.Value, after:=Worksheets("Data_Entry").Cells(NumRows,1))
Set FirstCell = Nothing
Do While Not R is Nothing and R<>FirstCell
If FirstCell is Nothing then Set FirstCell = R
CboReviewReviewRecords.addItem R.value (Or, if you want to return the second column like in your VLOOKUP above, use R.offset(0,1).value)
Set R=Worksheets("Data_Entry").Range("Records_Entered").Columns(1).FindNext
Loop
If you have Date/Time's in the column you're looking at, it gets much more complicated
Hopefully this gets you headed in the right direction

If column has word FAIL copy row to failed sheet (also allow multiple keywords)

Ok lets see if I can make this as easy to understand as possible. I'm working on an inspection workbook. This book is composed of many sheets each with its own name. I have been working with a few people to figure out ways to flag and copy "BLANKornovalue" cells but can not get the keyword idea to work.
Here is a short example of a sheet.
Name = Initiating devices
`$`Column A = adrress
`$`Column B = Type
`$`Column C = location
`$`Column D = Part#
`$`Column E = (RESULTS) dropdown choices
The only column I'm looking at at the moment is "E" "Results" Results can have many different choices from a drop down box, (FAIL, DAMAGED, LOW VOLTS, LOW AMPS, ets) I'm adding to it as i get feedback before the final copy. When an inspector clicks on the dropdown box and selects the words listed above that row would then be copied to the first available space on "FAILED" sheet. First available space would be A6 (due to a title graphic)
Then if the repairs are made the inspector or service tech would be able to change column "E" on the "FAILED" sheets page to another dropdown box. It would have choices like (PASS, REPLACED, REPAIRED, etc) When that was selected the same device and column in the "INITIATING DEVICES" would be updated and the item would be removed from the "FAILED" sheet all items would shift up leaving no spaces. This should happen after the device has been selected if possible.
I'm hoping that once i get a working example I will be able to adapt the code to work with several sheets, so that different values would place the items on different sheets. But that is yet to come.
Example
Column 6 (RESULTS) keyword = FAIL, or Fail or fail or Damaged, or low volts, or low amps, would copy all rows with this value to "FAIL" sheet
keyword = message change copy the row to a sheet called "Message changes" etc
Any help would be great and thanks in advance.
This should get you started. Its simple really if you know a little VBA. But I concur with ErikE that you should use Access or somthing similar
Option Compare Text
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim row As Long
Dim newRowId As Long
If ActiveSheet.Name = "Blad1" Then
For Each rng In Target.Cells
Select Case rng.Value
Case "FAIL"
row = rng.row
Rows(row).Cut
newRowId = findFirstAvailableRow(8, 1, "Blad2")
ThisWorkbook.Sheets("Blad2").Rows(newRowId).Insert Shift:=xlDown
Case Else
End Select
Next
End If
End Sub
Private Function findFirstAvailableRow(iStartIndex As Long, SearchColumnIndex As Long, workSheetName As String) As Integer
Dim i As Long
For i = iStartIndex To 32000
If ThisWorkbook.Sheets(workSheetName).Cells(i, SearchColumnIndex).Value = "" Then
findFirstAvailableRow = i
Exit For
End If
Next
End Function
Just copy it into your sheet and change the sheet names (I've got the swedish version and EVERY bloody thing is regionalized in Excel)

Resources