I've looked high and low for an explanation of this and I really am at my wits end, I don't even know if I'm asking the right question because I can't find any answers.
I have a userform where there are 2 modes: NEW and EDIT
When someone enters a NEW entry, there is a listbox field that allows multiple entries. This information gets concatenated into a single cell of the worksheet separated by commas.
When the form is in EDIT mode, it retrieves the information from the worksheet and populates the form with the existing row details based on an ID number. I can't seem to figure out how to get the list box to pull the selection from the worksheet back into the userform in EDIT mode
On clicking edit button to pull details from sheet into form:
Dim DataID as String
DataID = Trim(txt_RetrieveID.Text) Sheets("Lists").Range("I2").Value = DataID
lastrow = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
For I=3 to lastrow
If Worksheets("Data").Cells(i, 1).Value = DataID then
txt_date.Text=Sheets("Data").Cells(i,4).Value
''''etc for all the different fields
I was thinking that I'd have to split the concatenated field
Dim GroupValue as String
GroupValue = Sheets("Lists").Range("J2").Value
'"J2" is a fixed point where the list of items populates for the referenced record
Dim SingleValue() As String
SingleValue = Split(GroupValue, ", ")
Next
but I can't figure out how to bring those values back in as the default selection on the listbox in EDIT mode.
How can I take these multiple items and have them highlight as the selected value in EDIT mode?
this is an example that uses the Dictionary object to accomplish what you are asking
Dim dict As Scripting.Dictionary ' add microsoft scripting runtime to your tools/references
Private Sub CommandButton1_Click()
Dim x As Integer, y As Integer, Key As Variant
'clear prior selections in listbox1
ListBox1.MultiSelect = fmMultiSelectSingle
ListBox1.MultiSelect = fmMultiSelectMulti
y = 24 ' your "record selection" is done somehow
For x = 4 To 20 ' referencing your data values from the sheet, set as needed
If Cells(y, x) = "" Then Exit For
Key = Cells(y, x) ' must be a variant to read the key's value
ListBox1.Selected(dict(Key)) = True
Next x
End Sub
Private Sub UserForm_Initialize()
Dim x As Integer
Set dict = New Scripting.Dictionary
ListBox1.List = Split("Item3,Item2,Item0,Iterm8,Item10,Item44,Item09,Item23,Item11,item1,item12,item9,item31", ",")
'after the listbox is populated, build your dictionary
With ListBox1
For x = 0 To .ListCount - 1
dict.Add .List(x), x
Next x
End With
End Sub
Related
I have 2 excel sheets : one containing the source data and one contains the goal data. i have created userform that contains comboboxes(dropdownlists)and import button .
there are comboboxes that contain the names of the first row of the Source sheet and other comboboxes that contain the names of the first row of the goal sheet.
i want to compare the names in the comboboxes ( source and goal names) and match them if they are equal
than when i click on import Button , everything in the source excel sheet will be imported in the goal excel sheet in the right place.
how can i do that ?
I TRIED THIS CODE
dim sh =ThisWorkbook.Sheets("sourcedata")
dim sh2= ThisWorkbook.Sheets("goaldata")
dim i,j as integer
for i = 1 to Application.WorksheetFunction.CountA(sh.Range("1:1"))
for j = 1 to Application.WorksheetFunction.CountA(sh2.Range("1:1"))
if sh.cells(1,i).value = sh2.cells(1,j).value then
Me.comboBox1.value = sh.cells(1,i)
Me.comboBox2.value = sh2.cells(1,j)
Me.comboBox3.value = sh.cells(1,i)
Me.comboBox4.value = sh.cells(1,j)
end if
next
next
end sub
the problem that i get usually the same value in all comboboxes.
i want to get in all comboboxes the names of the rows in both sheets.
for example i have the rows names of the Source sheet : Date , Event and place
the rows names in the goal sheet are : Date and Event only
for example : in combobox1.value= Date should also in comboBox2.value = Date (because Date exists in both sheets)
combBox3.value = Event and Combobox 4.value should be Event
I want to insert Combobox5.value = place ( combobox 5 contain the names that exist only in one sheet and they don't have any match )
Any help?
I think I understood the 3 combobox part but not completely the "which data should be copied" part so let's already advance on the combobox part.
Some notes about your code:
When you don't mention a dataType in you dim the vars are by default in variant type => e.g. dim i => is the same as dim i as variant. although not always a problem it could lead to unexpected behaviour;
The "combobox.value" is to get the selected value of the combobox, not to add items to it. Looking at your desc. and code I think you intented to add items.
So hereunder a revised version based on my assumptions. instead of using the "add ..Item" I just assigned the sheet cells to arrays as we can then manipulate these directly in memory, allowing operations like comparing, copying, etc.. to be performed much faster.
Option Explicit
Sub UserForm_Initialize()
Dim arr, arr2
arr = Sheet1.Range("A1:c1").Value2
Me.ComboBox1.List = Application.WorksheetFunction.Transpose(arr)
arr2 = Sheet2.Range("A1:c1").Value2
Me.ComboBox2.List = Application.WorksheetFunction.Transpose(arr2)
Dim i As Long, arr3, ii As Long: ii = 1
ReDim arr3(1 To 1, 1 To UBound(arr, 2))
For i = 1 To UBound(arr, 2)
If arr(1, i) <> arr2(1, i) Then
arr3(1, ii) = arr(1, i)
ii = ii + 1
End If
Next i
Me.ComboBox3.List = Application.WorksheetFunction.Transpose(arr3)
End Sub
Have a look at it and let me know how it went.
I successfully managed to generate ListBoxes dynamically. But I am now struggling with addressing and populating those generated ListBoxes. Additionally, I can't figure out how to activate the MultiSelect Property of those ListBoxes. Is that only possible with ActiveX?
I first tried ActiveX - ListBoxes on userForm. Now I switched back to "normal" ListBoxes on the WorkSheet. "FS" is the name of my Worksheet which I am working on. For understanding: I am looping through the columns on worksheet FS and creating one ListBox per Column. In each ListBox the entries of the according column will be added.
For i = 1 To 10
LastRow = FS.Cells(Rows.Count, i).End(xlUp).Row
With FS
Set lb = FS.Shapes.AddFormControl(xlListBox, 100, 10, 100, 100)
lb.ControlFormat.MultiSelect = 2
For Each cell In FS.Range(Cells(1, i), Cells(LastRow,i)).Cells
lb.ControlFormat.AddItem cell.Value 'This is the problematic line
Next cell
End With
Next i
I suggest you do it like so:
Sub test()
''''Declarations'''''''''''''''''''''''''''
Dim lb As ListBox '
Dim sht As Worksheet '
Dim rng As Range '
Dim cell As Range '
Dim i As Long '
'''''''''''''''''''''''''''''''''''''''''''''
Set sht = ThisWorkbook.Worksheets("Name of your worksheet")
For i = 1 To 10
With sht
Set rng = .Range(.Cells(1, i), .Cells(.Rows.Count, i).End(xlUp))
Set lb = sht.ListBoxes.Add(100 * i, 10, 100, 100) 'just an indicative way to create the List boxes without them overlapping
End With
lb.Name = "ListBox" & i
lb.MultiSelect = 2
For Each cell In rng
lb.AddItem cell.Value
Next cell
Next i
End Sub
UPDATE (to cover the comment made)
I updated the code above to name the list boxes as "ListBox1" , "ListBox2" etc instead of "List Box 1"etc.
To refer to one of the list boxes you need to use a reference to the collection of ListBoxes. This collection belongs to the sheet where the listboxes are located. For example, to refer to "ListBoxi", where i=1,2...n you need to do it like so:
sht.ListBoxes("ListBox" & i)
Unfortunately there is no .SelectedItems.Count or similar method, that I know of, which you can use with a form control List Box.
Having that in mind, you can find the number of selected items of "ListBox1" for example, like so:
Dim selectedItems As Long
selectedItems = 0
Set lb = sht.ListBoxes("ListBox" & 1)
For i = 1 To lb.ListCount Step 1
If lb.Selected(i) Then
selectedItems = selectedItems + 1
End If
Next i
If selectedItems = 0 Then
MsgBox "No user selected"
End If
A few things to keep in mind:
The index of the first item varies from 0 to 1 depending on whether the list box is on a userform or not
To refer to a listbox using it's name like Listbox1.DoSomething, it needs to be an ActiveX control and not a Form control.
Use the .ControlFormat.ListFillRange instead, and set MultiSelect to 3. Something like this should work for you:
Sub tgr()
Dim FS As Worksheet
Dim lb As Shape
Dim i As Long
Set FS = ActiveWorkbook.Worksheets("FS")
For i = FS.Columns("A").Column To FS.Cells(1, FS.Columns.Count).End(xlToLeft).Column
Set lb = FS.Shapes.AddFormControl(xlListBox, (i - 1) * 100 + 10, 10, 100, 100)
With lb
.ControlFormat.MultiSelect = 3
.ControlFormat.ListFillRange = FS.Range(FS.Cells(1, i), FS.Cells(FS.Rows.Count, i).End(xlUp)).Address(External:=True)
End With
Next i
End Sub
I need advise from the pros here. i basically have 0 knowledge on vba excel.
I recently had designed a UserForm and i took advantage of online code.
First of all, i have this UserForm allowing me to key in a part number and search from this sheet call "MASTER" in "pntxt" textbox and it will return a list of values to text box 2 to 10. This part of the code is already working and running well.
To further enhance it, i would like to have the "update" button in this user form.
For example, one of the text box is name as "pricetxt" after calling out using values from "pntxt", as a user, i need to amend the "pricetxt" textbox. after which, it will update back my excel sheet.
I had tried the following code and it's not working.
Private Sub update2_Click()
Dim lastRow As Variant
Dim partno As Variant
Dim rowSelect As Variant
Dim x As Variant
If Trim(pntxt.Value) = vbNullString Then
MsgBox "Enter Part Number"
Else
partno = pntxt.Value
Sheets("MASTER").Select
Set wS = Worksheets("MASTER")
lastRow = wS.Cells(Rows.count, 2).End(xlUp).Row
For x = 2 To lastRow
If wS.Cells(x, 2).Value = partno Then Rows(x).Select
Next
rowSelect = ActiveCell.Row
Cells(rowSelect, 20) = Me.pricetxt.Value
End If
End Sub
The code above does not returned the "pricetxt" values to the corresponding rows as "pntxt" values.
I am setting up a combo box to update a pivot table.
I need the value the combo box returns to be different from the selected text.
For example. You select a product's name in the drop down box, "Cheerios". It has a SKU number of 1234. I need the combo box to return the 1234.
Edit:
Below is an image of where I am getting my list populated from. Column B is what is being displayed in the drop down, column A is what I need returned.
Edit 2:
Private Sub cmb_SkuSelect_Click()
Dim xlSheetSort As Worksheet
Dim lastRow As Long
Dim skuValue As Integer
Set xlSheetSort = ActiveWorkbook.Worksheets("Sort")
lastRow = xlSheetSort.Range("A1").End(xlDown).Row
With xlSheetSort.Range("B1:B" & lastRow)
Set c = .Find(cmb_SkuSelect.Value, LookIn:=xlValues)
If Not c Is Nothing Then
skuValue = xlSheetSort.Range("A" & c.Row).Value
End If
End With
cmb_SkuSelect.Value = ""
ActiveWorkbook.ActiveSheet.Range("A4").Value = skuValue
updatePivot skuValue
End Sub
updatePivot:
Public Sub updatePivot(ByVal sku As Integer)
Dim xlSheet As Worksheet
Dim xlPTable As PivotTable
Set xlSheet = ActiveWorkbook.Worksheets("Sku Inventory")
For Each xlPTable In xlSheet.PivotTables
With xlPTable
.PivotFields("Sku Number").CurrentPage = sku
End With
Next
End Sub
Try that:
Private Sub ComboBox1_Change()
Dim valueToLook As String
valueToLook = ComboBox1.Value
Dim sku, i As Integer
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
For i = 1 To LastRow
If Cells(i, 2).Value = valueToLook Then
sku = Cells(i, 1).Value
MsgBox sku
Exit For
End If
Next i
End Sub
Yes, it's definitely possible - all you need to do is make the combobox a multi-column one, set its BoundColumn to the SKU Number's column and hide that column afterwards. It's a late answer, but it solves your problem.
I'm not going to bother with your existing structure, but rather present a simple example that you can adapt to your needs afterwards. Assuming you already have the form (e.g. UserForm1) and the combobox (e.g. ComboBox1) in a standard workbook, paste this into your userform module:
Private Sub ComboBox1_Change()
' Show the expected result to the user
MsgBox Me.ComboBox1.Value
End Sub
Private Sub UserForm_Initialize()
Dim cbitems(2, 1) As Variant
' Set the number of columns in the combobox to 2 (i.e. Product Name and SKU Number)
Me.ComboBox1.ColumnCount = 2
' Set the 2-nd column's value to be used as the value of the combobox (i.e. the SKU Number)
Me.ComboBox1.BoundColumn = 2
' Set the 2-nd column's width to 0, hiding the column (i.e. only the Product Name is visible)
Me.ComboBox1.ColumnWidths = ";0"
' Populate a 2D array with the values of the combobox columns
cbitems(0, 0) = "Cheerios"
cbitems(0, 1) = "1234"
cbitems(1, 0) = "Apples"
cbitems(1, 1) = "1672"
cbitems(2, 0) = "Peaches"
cbitems(2, 1) = "3722"
' Populate the combobox with the above array, using the List method (i.e. not the AddItem one)
Me.ComboBox1.List = cbitems
' Set the 1-st item of the combobox to be its default one
Me.ComboBox1.ListIndex = 0
End Sub
The comments explain what happens. All you have to do is adapt the code to your usage scenario (e.g. you'll probably want to populate the array/combobox using a loop, maybe move the relevant code to a different Sub than the userform's Initialize event, potentially add column headers if you want both columns to be visible, etc.)
Note: The Change event of the combobox will fire a couple of times when the combobox is first drawn on the userform, so you might get a few empty message-boxes at the start. Don't mind them, the important ones are those after you select some item from the list later on. The message boxes are just for convenience anyway, and, along with the last line in the userform's Initialize event, they can be safely removed from the code once you get the idea.
I'm trying to work out the code needed to filter or search a listbox included on a userform that contains multiple columns and multiple rows. On the userform, I have a textbox that allows user input that would ideally filter out the non-matching entries from the Listbox.
I've found a few solutions online, but nothing that I could get to work on a listbox with multiple columns in a userform. The way it's coded from the example is trying to transpose a single column of data, and I'm guessing I need to alter the code to use an array. I'm just not strong enough with VBA to know exactly how to change that piece.
I'm also receiving an error on the GoToRow() function, but I believe it's tied into the single vs multiple column listbox issue.
I've included a link to a basic mockup of my project below since I'm using a userform with a listbox and textbox that are named.
https://www.dropbox.com/s/diu05ncwbltepqp/BasicListboxExample.xlsm?dl=0
The listbox on my userform has five columns and is named ProjectList, and the textbox is named SearchTextBox.
Option Explicit
Const ProjectNameCol = "B"
Dim PS As Worksheet
Private loActive As Excel.ListObject
Private Sub UserForm_Activate() ' Main code on Userform Activation, calls support subs
Set PS = Sheets("ProjectSheet") 'stores value for Project Sheet Worksheet as PS
Set loActive = ActiveSheet.ListObjects(1)
'populates listbox with data from ProjectSheet Worksheet named table
ProjectList.RowSource = "AllData"
'# of Columns for listbox
ProjectList.ColumnCount = 5
'Column Width for listbox
ProjectList.ColumnWidths = "140; 100; 100; 100; 100"
Me.ProjectList.TextColumn = 1
Me.ProjectList.MatchEntry = fmMatchEntryComplete
ResetFilter
End Sub
Private Sub SearchTextBox_Change()
'Can't get anything to work here
ResetFilter
End Sub
Sub ResetFilter()
Dim rngTableCol As Excel.Range
Dim varTableCol As Variant
Dim RowCount As Long
Dim FilteredRows() As String
Dim i As Long
Dim ArrCount As Long
Dim FilterPattern As String
'the asterisks make it match anywhere within the string
If Not ValidLikePattern(Me.SearchTextBox.Text) Then
Exit Sub
End If
FilterPattern = "*" & Me.SearchTextBox.Text & "*"
Set rngTableCol = loActive.ListColumns(1).DataBodyRange
'note that Transpose won't work with > 65536 rows
varTableCol = Application.WorksheetFunction.Transpose(rngTableCol.value)
RowCount = UBound(varTableCol)
ReDim FilteredRows(1 To 2, 1 To RowCount)
For i = 1 To RowCount
'Like operator is case sensitive,
'so need to use LCase if not CaseSensitive
If (LCase(varTableCol(i)) Like LCase(FilterPattern)) Then
'add to array if ListBox item matches filter
ArrCount = ArrCount + 1
'there's a hidden ListBox column that stores the record num
FilteredRows(1, ArrCount) = i
FilteredRows(2, ArrCount) = varTableCol(i)
End If
Next i
If ArrCount > 0 Then
'delete empty array items
'a ListBox cannot contain more than 65536 items
ReDim Preserve FilteredRows(1 To 2, 1 To Application.WorksheetFunction.Min(ArrCount, 65536))
Else
're-initialize the array
Erase FilteredRows
End If
If ArrCount > 1 Then
Me.ProjectList.List = Application.WorksheetFunction.Transpose(FilteredRows)
Else
Me.ProjectList.Clear
'have to add separately if just one match
'or we get two rows, not two columns, in ListBox
If ArrCount = 1 Then
Me.ProjectList.AddItem FilteredRows(1, 1)
Me.ProjectList.List(0, 1) = FilteredRows(2, 1)
End If
End If
End Sub
Private Sub ProjectList_Change()
GoToRow
End Sub
Sub GoToRow()
If Me.ProjectList.ListCount > 0 Then
Application.Goto loActive.ListRows(Me.ProjectList.value).Range.Cells(1),True
End If
End Sub
Over in my modules I have:
Function ValidLikePattern(LikePattern As String) As Boolean
Dim temp As Boolean
On Error Resume Next
temp = ("A" Like "*" & LikePattern & "*")
If Err.Number = 0 Then
ValidLikePattern = True
End If
On Error GoTo 0
End Function