Sep 01 2021 11:55 AM - edited Sep 02 2021 09:49 AM
I've seen VBA code that will allow one to select multiple items from a drop-down list. I've seen VBA code that allow you to create a drop down list and return a different value. What I need is a combination of the two. I want to present a user with a logical list of choices I.e. Living Room, Sun Room, Dining Room, etc. and allow them to select more than one. The list would show the full name but return the abbreviation(s) of the list items selected.
Drop Down List
All | ALL |
Living Room | LR |
Sun Room | SR |
Dining Room | DR |
Kitchen | K |
Kitchen Pantry | KP |
Breakfast Room | KB |
Foyer | F |
Returned Values:
LR, DR, K, KB
K, F
Has anyone come across code that would accomplish this or have any suggestions. As I mentioned I've found VBA code that does one or the other but not the combination.
Thanks.
Sep 01 2021 01:02 PM
I hope it helps you, so I kindly ask you it this is your solution,please hit the like button and mark it as solved.
Sub OutputFromMultiSelectListBox()
Dim LoopIndex As Integer
Dim OutputList As String
For LoopIndex = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(LoopIndex) Then
OutputList = OutputList & ListBox1.List(LoopIndex) & vbCrLf
End If
Next LoopIndex
MsgBox "Selected items are:" & vbCrLf & OutputList
End Sub
Sep 01 2021 01:24 PM
@Juliano-Petrukio thanks for the reply. I added your suggested code but it didn't appear to change anything. Currently I have a piece of code that was supplied by ExtendOffice that I found while researching. This code provides the code utilizing vlookup. If I could get it to allow multiple selections, that would be the end goal.
Private Sub Worksheet_Change(ByVal Target As Range)
selectedNa = Target.Value
If Target.Column = 3 Then
selectedNum = Application.VLookup(selectedNa, ActiveSheet.Range("dropdown"), 2, False)
If Not IsError(selectedNum) Then
Target.Value = selectedNum
End If
End If
End Sub
Sep 01 2021 09:44 PM
Sep 02 2021 05:14 AM
Sep 02 2021 06:36 AM
Sep 02 2021 09:49 AM
Sep 02 2021 10:21 AM
Solution
Find attached and the code below as well.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Dim selectedNum As Variant
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 3 Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
selectedNum = Application.VLookup(Newvalue, ActiveSheet.Range("dropdown"), 2, False)
Newvalue = selectedNum
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & ", " & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
Sep 02 2021 10:28 AM
Sep 02 2021 10:21 AM
Solution
Find attached and the code below as well.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Dim selectedNum As Variant
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 3 Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
selectedNum = Application.VLookup(Newvalue, ActiveSheet.Range("dropdown"), 2, False)
Newvalue = selectedNum
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & ", " & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub