I would like to know if there is a way to add selected multiple combo box values to a dynamic array. So far this my code below, at the moment I can only submit the one selected Combobox value to the array list.
Private Sub UserForm_Initialize()
ComboBox1.AddItem "1"
ComboBox1.AddItem "2"
ComboBox1.AddItem "3"
End Sub
Private Sub CommandButton1_Click()
Dim cmbbox(10) As String
Dim i As Integer
For i = LBound(cmbbox) To UBound(cmbbox)
cmbbox(i) = ComboBox1.Value
MsgBox cmbbox(i)
Next i
End Sub
I would like to be able to select a value from the combo box, and then that value gets passed to my array at the 0 position, and then if the another value is selected from the combo box, then that value is passed to my array's 1 position etc...
This should do:
For Each Item In ComboBox1.List
If Not Item Then
MsgBox Item
End If
Next
Edit: Did I miss your point here, or did you change your question? According to what I read now, you want to append combobox value at the end of your array each time you hit commandbutton. You should do as follows:
Define your array outside of your sub (at the very top):
Dim cmbbox() As Variant
and the code should look like:
Private Sub CommandButton1_Click()
If Len(Join(cmbbox, "")) = 0 Then 'if your array is empty add the first value from combobox
ReDim cmbbox(0)
cmbbox(0) = ComboBox1.Value
Else 'if your array is not empty redim your array and add value from combobox
ReDim Preserve cmbbox(UBound(cmbbox) + 1)
cmbbox(UBound(cmbbox)) = ComboBox1.Value
End If
MsgBox "Last Added Item : " & cmbbox(UBound(cmbbox))
End Sub
As #Tehscript has indicated, the property you're after is .List which returns a two-dimensional, zero-based array: the first dimension being 'rows' and the second 'columns'.
From your question, it seems as if you want a specific index (or indices) from the row dimension. If your ComboBox only has one column then the second dimension could be hard-coded as zero.
A For Each loop would be okay, but the problem is that it will loop through every item in the array rather than just each row. It might be more efficient, therefore, to run a For [index] loop. Let's say you want the first and third items in your ComboBox, then the code snippet would be:
Dim i As Long
Dim v As Variant
v = ComboBox1.List
For i = 0 To UBound(v, 1)
If i = 0 Or i = 2 Then
MsgBox v(i, 0)
End If
Next
Related
currently my code prompts the user to enter a comma separated list of titles. However, is there a way i can change the code so instead the user can search for the title desired from a drop down menu, click a checkbox by the title, and able to keep searching for required titles until done. And store these strings in an array.
Dim arWords() As String
myt = InputBox("Enter User Input")
arWords() = Split(myt, ",")
For X = 0 To UBound(arWords)
myf = myf & arWords(X) & vbNewLine
Next X
I have an array (arrH) later in the code that has all the titles stored so i think id have to use this as the source, if i need one?. Or so i believe. Im still learning.
arrH = Split(arrTxt(HeaderRow), vbTab)
Thanks!
Create a UserForm.
"the user can search for the title desired from a drop down menu, click a checkbox by the title, and able to keep searching for required titles until done".
UserForm with a ComboBox & CheckBox. On CheckBox_Change event, have the script store the value of ComboBox to a public module-level array and iterate the array index.
Have a "Done" button that hides the userform.
Here's what the Userform code module looks like:
Public SelectedTitles As Variant, ArrCount As Long, EnableEvents As Boolean
Private Sub CheckBox1_Change()
'User has indicated they want to add the currently selected item to the list
If Not EnableEvents Then Exit Sub
If ArrCount = 0 Then 'First item, create the array
SelectedTitles = Array("")
Else
ReDim Preserve SelectedTitles(UBound(SelectedTitles) + 1) 'Next items, add one more space in the array
End If
'Add the selected title to the array
SelectedTitles(ArrCount) = ComboBox1.Value
'Increment the counter
ArrCount = ArrCount + 1
'Reset the checkbox and the combobox
EnableEvents = False
CheckBox1.Value = False
ComboBox1.Value = ""
EnableEvents = True
End Sub
Private Sub CommandButton1_Click()
'Done Button
Me.Hide
End Sub
Private Sub UserForm_Initialize()
EnableEvents = True
End Sub
Here is a sub to aid in adding items to a ComboBox list:
Sub ComboBox_AddFromArray(ByRef ComboBox As Object, ListArray As Variant)
ComboBox.Clear
If IsArray(ListArray) Then
Dim i As Long
For i = LBound(ListArray) To UBound(ListArray)
ComboBox.AddItem ListArray(i), ComboBox.ListCount
Next i
Else
ComboBox.AddItem ListArray, 0
End If
End Sub
This function would go after Load UserForm1 and before UserForm1.Show. And you would input the arguments like ComboBox_AddFromArray UserForm1.ComboBox1, arrH.
The way you'd put this all together is by having a controlling function that does all of the Userform processes and then returns what you need, which is that user selected array of titles.
This is what that would look like
Function UserInputForm(ByRef ArrayOfAllTitles As Variant) As Variant
Load UserForm1
ComboBox_AddFromArray UserForm1.ComboBox1, ArrayOfAllTitles
UserForm1.Show
UserInputForm = UserForm1.SelectedTitles
Unload UserForm1
End Function
And Finally, an example of how to include that function into your main sub:
Dim SelectedTitles As Variant
SelectedTitles = UserInputForm(arrH)
'SelectedTitles is now an array of Variant/String values
Dim i As Long
For i = LBound(SelectedTitles) To UBound(SelectedTitles)
Debug.Print SelectedTitles(i)
'Access individual members of the array using SelectedTitles(i)
Next i
I have Sheet1.ComboBox1 that I would like to fill with an array of values. This array is stored on Sheet2. This array is a list of all customers to be used in the excel file. All customers are listed in one single column.
Some customers appear more than once in the column. It varies by how many part numbers a customer has.
I would like to fill a Sheet1.ComboBox1 with this array, however, I don't want duplicate values.
I read online that I can convert the array into a collection which will automatically weed out duplicates.
I would like to take this collection and input it into the Sheet1.ComboBox1, however, upon some research, I've found that collections are read-only...(am I wrong in this conclusion?)
One strategy I saw was to convert the customer array into a collection and then back into a new simplified array. The hope is to store this new array into Sheet 3, then pull this array into ComboBox1.List. I've posted my code below of this attempt.
'Converts collection to an accessible array
Function collectionToArray(c As Collection) As Variant()
Dim a() As Variant: ReDim a(0 To c.Count - 1)
Dim i As Integer
For i = 1 To c.Count
a(i - 1) = c.item(i)
Next
collectionToArray = a
End Function
Sub PopulateComboBoxes()
Dim ComboBoxArray As New Collection, customer
Dim CustomerArray() As Variant
Dim newarray() As Variant
Dim i As Long
CustomerArray() = Sheet2.Range("A5:A2000")
On Error Resume Next
For Each customer In CustomerArray
ComboBoxArray.Add customer, customer
Next
newarray = collectionToArray(ComboBoxArray)
Sheet3.Range("A1:A2000") = newarray
Sheet1.ComboBox1.List = Sheet3.Range("A1:2000")
I used ' CustomerArray() = Sheet2.Range("A5:2000") ' not because there are that many rows full of values in Sheet 2, rather, that I cover all bases when more customers are eventually added to the list. The total size of my Sheet 2 is currently A1:A110, but I want to future proof it.
When I run the code, the Array is successfully reduced and the new array is placed into Sheet3 with no duplicates. However, the first Customer entry is repeated after the last unique customer value is defined. (A46 is last unique customer, A47:A2000 its the same customer repeated)
Additionally, Sheet1.ComboBox1 remains empty.
Is anyone able to explain how to restrict the number of rows filled by 'collectionToArray' , instead of filling all 2000?
Also, where am I going wrong with filling the ComboBox1? Am I missing a command/function to cause the box to fill?
You don't need that function to make a New Array, seems Excessive to me.
Assigning to CustomerArray will take care of Future Additions in column
You can directly pass on the Collection value to ComboBox
You are missing On Error Goto 0 in your code after addition to Collection. That is making all to errors after that invisible and hard for you to identify which part of code is causing problems.
Here Try this:
Sub PopulateComboBoxes()
Dim ComboBoxArray As New Collection
Dim CustomerArray() As Variant
Dim newarray() As Variant
Dim i As Long
With Worksheets("Sheet2")
CustomerArray = .Range("A5:A" & .Range("A5").End(xlDown).row).Value
End With
On Error Resume Next
For i = LBound(CustomerArray) To UBound(CustomerArray)
ComboBoxArray.Add CustomerArray(i, 1), CustomerArray(i, 1)
Next
On Error GoTo 0
For Each Itm In ComboBoxArray
Worksheets("Sheet1").ComboBox1.AddItem Itm
Next
End Sub
First, you should assign your range dynamically to CustomerArray...
With Sheet2
CustomerArray() = .Range("A5:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
Then, you should disable error handling after you've finished adding the items to your collection. Since you did not do so, it hid the fact that your range reference in assigning the values to your listbox was incorrect, and that you didn't use the Value property to assign them. So you should disable the error handling...
On Error Resume Next
For Each customer In CustomerArray
ComboBoxArray.Add customer, customer
Next
On Error GoTo 0
Then, when transferring newarray to your worksheet, you'll need to transpose the array...
Sheet3.Range("A1").Resize(UBound(newarray) + 1).Value = Application.Transpose(newarray)
Then, as already mentioned, you should assign the items to your listbox with Sheet3.Range("A1:A2000").Value. However, since newarray already contains a list of the items, you can simply assign newarray to your listbox...
Sheet1.ComboBox1.List = newarray
So the complete code would be as follows...
Sub PopulateComboBoxes()
Dim ComboBoxArray As New Collection, customer As Variant
Dim CustomerArray() As Variant
Dim newarray() As Variant
With Sheet2
CustomerArray() = .Range("A5:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
On Error Resume Next
For Each customer In CustomerArray
ComboBoxArray.Add customer, customer
Next
On Error GoTo 0
newarray = collectionToArray(ComboBoxArray)
Sheet3.Range("A1").Resize(UBound(newarray) + 1).Value = Application.Transpose(newarray)
Sheet1.ComboBox1.List = newarray
End Sub
it could be achieved in a number of ways. using collection or dictionary object. i am just presenting simple method without going through collection or dictionary since only 5000 rows is to be processed. it could be further shortened if used directly with combo box without using OutArr. As #Domenic already answered it with explanations, may please go along with that solution.
Option Explicit
Sub test()
Dim InArr As Variant, OutArr() As Variant
Dim i As Long, j As Long, Cnt As Long
Dim have As Boolean
InArr = ThisWorkbook.Sheets("sheet2").Range("A5:A2000")
ReDim OutArr(1 To 1)
Cnt = 0
For i = 1 To UBound(InArr, 1)
If InArr(i, 1) <> "" Then
have = False
For j = 1 To UBound(OutArr, 1)
If OutArr(j) = InArr(i, 1) Then
have = True
Exit For
End If
Next j
If have = False Then
Cnt = Cnt + 1
ReDim Preserve OutArr(1 To Cnt)
OutArr(Cnt) = InArr(i, 1)
End If
End If
Next i
Sheet3.Range("A1").Resize(UBound(OutArr)).Value = Application.Transpose(OutArr)
Sheet1.ComboBox1.Clear
Sheet1.ComboBox1.List = OutArr
Debug.Print Sheet1.ComboBox1.ListCount
End Sub
I'm trying to populate a combo box with UNIQUE values only, no duplicates; which I believe is working fine, but something is wrong with my logic in the second For loop
The below logic goings as follows...
Private Function PopulateComboBoxWeeks()
Dim i As Long
Dim x As Long
Dim LR As Long
Dim ws As Worksheet
Dim SearchNextWeek As String
LR = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set ws = ActiveSheet
With UserForm1.ComboBox1
''' Fill first slot in ComboBox1 with the value of last row in Column "A"
.AddItem ws.Range("A" & LR).Value
''' Loop to search Column "A" for items to fill with, start on the second last row, since the above line fills the first line
For i = LR - 1 To 2 Step -1
''' Loop to search the ComboBox.List() array
For x = 0 To .ListCount
''' Array list starts at 0
If Not (.List(x) = ws.Range("A" & i).Value) Then
.AddItem ws.Range("A" & i).Value
End If
Next x
Next i
End With
End Function
It's checking the Array list properly, but I'm stuck on the second For loop, if I start at index 0 of my array and it's taking into account the total items in the array with .ListCount. Thus it's giving me the below error...
Run-Time error '381':
Could not get the List property. Invalid property array index
Which could only mean I'm referencing an array item outside of the array size. I've tried doing .ListCount - 1 but this gives me an infinite loop. I think all my logic is sound here except this one item and I'm not sure how to get passed this point.
Iterating any collection as you're changing it is always a bad idea.
Don't loop on anything. Just tell it what range you want to use.
If you can't do that, then you need to first get the unique values into an array (single-dimensional), then assign ComboBox1.List = theArray. Done.
There are two things you want to do:
Figure out what the unique values are
Assign the List property
Don't do these two things in one single nested spaghetti loop. Separate them.
Dim allValues As Variant
'get a single-dimensional array with all the values in the column:
allValues = Application.WorksheetFunction.Transpose(ws.Range("A2:A" & LR).Value)
'let's use built-in collection keys to ensure uniqueness:
Dim uniqueValuesColl As Collection
Set uniqueValuesColl = New Collection
Dim currentIndex As Long
For currentIndex = LBound(allValues) To UBound(allValues)
If Not IsError(allValues(currentIndex)) Then
On Error Resume Next
uniqueValuesColl.Add allValues(currentIndex), Key:=CStr(allValues(currentIndex))
If Err.Number <> 0 Then
' we already have that value
Err.Clear
End If
On Error GoTo 0
End If
Next
'now we know what the unique values are - get them into an array:
ReDim uniqueValues(0 To uniqueValuesColl.Count - 1)
Dim currentItem As Variant
currentIndex = 0
For Each currentItem In uniqueValuesColl
uniqueValues(currentIndex) = currentItem
currentIndex = currentIndex + 1
Next
'just assign the list of unique values
ComboBox1.List = uniqueValues
So I'm iterating all values once, and then the unique values once. But you're currently iterating them once for every single item in the non-unique list. So this solution is O(n+m) where n is the number of non-unique items and m is the number of unique items, whereas your nested loop is O(n2) (the big-O notation of your solution is actually more complicated than that, but I'm no big-O expert).
I will try to illustrate the scenario by only focus on the problem and take out all the non essential issues/scripts.
User selects multiple non-contiguous cells. VBA would do a few things...then insert a column.
If the selected cells happened to be at the right side of the columns, the content would move one column right of the original selected cells. I need to re-select the cells with the original content before exit sub.
For instance,
the user selects "A1", "C3", and "D4:E6".
the vba insert a column at "B"
now the content of "C3" and "D4:E6" move to "D3" and "E4:F6"
I need the vba to select "A1", "D3" and "E4:F6" before exit sub.
I have considered a few methods:
Offset the entire selection to one column right.
selection.offset(0,1).select
This is not a good solution as "A1" would move to "B1". It is only ok if the user selected cells are all at the right side of the inserted column.
Put each cell of selection (selected range) into array. Change the affected cells' range. and use vba to select them all again. The problem is that the vba I wrote can't select the entire array of ranges (multiple non contiguous cells) at once. It only selects the last cell in the array. Here is the summarized code:
Sub mtArea()
Dim Cell, Rg, sRg() As Range
Dim h, i, j, k, noCell, Cnt As Long
Set Rg = Selection
noCell = Rg.Cells.Count
k = 0
' assign each cell in selection to a specific array
If Rg.Areas.Count > 1 Then
ReDim sRg(noCell)
For Each Cell In Rg
k = k + 1
Set sRg(k) = Cell
Next Cell
End If
' select the new located cells
For i = 1 To noCell
If sRg(i).Column > 5 Then ' assuming insert column is "E"
h = 1
Else
h = 0
End If
sRg(i).Offset(0, h).Select
Next i
End Sub
In this case, only the last cell in the original range is being selected. Is there a way to select the entire sRg() range array?
I also hope to explore this way:
Dim Rg as Range
Set Rg = Selection
When user selects multiple non contiguous cells, is there a way for vba to change the individual cells range location in the Rg variable?
What should be the method?
Thank you.
If you assign a Name to the range, the cells will be adjusted after the column is inserted:
Sub RememberTheCells()
Range("A1,C3,D4:E6").Select
Selection.Name = "Previous"
Columns("B:B").Insert Shift:=xlToRight
Range("Previous").Select
MsgBox Selection.Address
End Sub
Try this
Sub InsertDemo()
InsertAndAdjustSelection 2
End Sub
Sub InsertAndAdjustSelection(Col As Long)
Dim strAddress() As String
Dim i As Long
' Save adresses of selected cells
strAddress = Split(Selection.Address, ",")
' Insert Column
Columns(Col).Insert
' Unpdate saved addresses
For i = 0 To UBound(strAddress)
If Range(strAddress(i)).Column >= Col Then
strAddress(i) = Range(strAddress(i)).Offset(, 1).Address
End If
Next
' Select range
Range(Join(strAddress, ",")).Select
End Sub
I am trying to loop through a table that has a column for "customers" and "dollar amount". If my loop finds a customer called "greg" or "henry" I want to add his "dollar amount" to an array of an unknown size.
Can someone please help me?
If by unknown size, you mean that number of elements is unknown, you could use a dynamic array.
Dim aArray() As Single ' or whatever data type you wish to use
ReDim aArray(1 To 1) As Single
If strFirstName = "henry" Then
aArray(UBound(aArray)) = 123.45
ReDim Preserve aArray(1 To UBound(aArray) + 1) As Single
End If
Ubound(aArray) throws an error if the array hasn't been dimensioned, so we start by adding an element to it. That leaves us with an empty element at the end of the text, so your code should account for that. aArray(Ubound(aArray)-1) will give you the last valid element in the array.
Private Sub ArrayMy(DataRange)
Dim DataIndex() As String
i = 0
On Error Resume Next
ReDim DataIndex(0)
For Each c In DataRange
DataIndex(i) = c
i = i + 1
ReDim Preserve DataIndex(i)
Next
End Sub
I think is better to use the listArray object:
Dim list, name as variant
Set list = CreateObject("System.Collections.Arraylist")
For i = 1 to Last then ''Loop in the range
If strName = "Henry" then
list.Add ValueToAdd ''add to the list
End if
Next
and then you can loop in the list
For Each name in List
Msgbox name
Next