Listbox VBA for Multiple Selection in single cell separated by a comma - list not appearing

[jessitarexcel]

Hello,

I have a workbook with a worksheet called Audit_TP_BPP and a worksheet called List. On this list sheet there is a table with a named range called CommAudList.

One column in the table on the Audit_TP_BPP worksheet requires a dropdown list that refers to the named range CommAudList and this requires multiple selections to appear in a single cell separated by a comma.

The issue is that the list is not showing on the data sheet but it is showing in the developer tab:

I followed a tutorial online and it seems that there is something missing or there is something I have done wrong. I have gone back and read additional articles but for some reason I am just missing this one last point to make this work.

The properties are:

UserForm - frmDVList

ListBox

CommandButton: - OK

CommandButton: Cancel/Close

This the VBA code used for the form, listbox and command buttons:

Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub cmdOK_Click()
Dim strSelItems As String
Dim lCountList As Long
Dim strSep As String
Dim strAdd As String
Dim bDup As Boolean

On Error Resume Next
strSep = ", "

With Me.lstDV
For lCountList = 0 To .ListCount - 1

If .Selected(lCountList) Then
strAdd = .List(lCountList)
Else
strAdd = ""
End If

If strSelItems = "" Then
strSelItems = strAdd
Else
If strAdd <> "" Then
strSelItems = strSelItems & strSep & strAdd
End If
End If

Next lCountList
End With

With ActiveCell
If .Value <> "" Then
.Value = ActiveCell.Value & strSep & strSelItems
Else
.Value = strSelItems
End If
End With

Unload Me

End Sub


Private Sub lstDV_Click()

End Sub

Private Sub UserForm_Initialize()
Me.lstDV.RowSource = strDVList
End Sub

And this is the VBA code that has been entered onto the sheet - Audit_TP_BPP

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strList As String
On Error Resume Next
'temporarily turn off Events
Application.EnableEvents = False
'set a range with all DV cells on sheet
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
'if no DV cells, exit macro
If rngDV Is Nothing Then GoTo exitHandler
If Not Intersect(Target, rngDV) Is Nothing Then
'if active cell IS in DV range
'check if it's a List (DV type 3)
If Target.Validation.Type = 3 Then
'if list, get source list name
strList = Target.Validation.Formula1
strList = Right(strList, Len(strList) - 1)
'pass source list name to global variable
strDVList = strList
'open UserForm
frmDVList.Show
End If
End If

exitHandler:
'turn on Events
Application.EnableEvents = True

End Sub

Result: The listbox appears but it does not show anything. It also only appear sometimes but I believe that is a network issue more than a VBA issue.

There is additional code in the sample worksheet that I used, however, when I copy in the full code below it tells me there is a variable error. This is the VBA from the sample excel sheet:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strList As String
On Error Resume Next
Application.EnableEvents = False

Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Not Intersect(Target, rngDV) Is Nothing Then
If Target.Validation.Type = 3 Then

strList = Target.Validation.Formula1
strList = Right(strList, Len(strList) - 1)
strDVList = strList
frmDVList.Show
End If
End If

exitHandler:
Application.EnableEvents = True

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strSep As String
strSep = ", "
Application.EnableEvents = False
On Error Resume Next
If Target.Count > 1 Then GoTo exitHandler


Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else

newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If newVal = "" Then
'do nothing
Else
If oldVal = "" Then
Target.Value = newVal
Else
Target.Value = oldVal & strSep & newVal
End If
End If

End If

exitHandler:
Application.EnableEvents = True
End Sub

I know that the difference between my sheet and the tutorial sheet is that they have two lists in two different columns, but I only have one list in one column. I don't have the option explicit in my VBA as it was causing issues. I understand that having Option Explicit means that I must declare all of the variables. That tells me that I must have a variable wrong somewhere. I know this is going to be something simple that I have missed but I cannot see the solution. Is anyone able to assist me at all?

I know some VBA but some of this is new to me and I just need some guidance. Thank you.

 

[jessitarexcel]

When using the alternate VBA as described above with the Option Explicit:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strList As String
On Error Resume Next
Application.EnableEvents = False

Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Not Intersect(Target, rngDV) Is Nothing Then
If Target.Validation.Type = 3 Then

strList = Target.Validation.Formula1
strList = Right(strList, Len(strList) - 1)
strDVList = strList
frmDVList.Show
End If
End If

exitHandler:
Application.EnableEvents = True

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strSep As String
strSep = ", "
Application.EnableEvents = False
On Error Resume Next
If Target.Count > 1 Then GoTo exitHandler


Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else

newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If newVal = "" Then
'do nothing
Else
If oldVal = "" Then
Target.Value = newVal
Else
Target.Value = oldVal & strSep & newVal
End If
End If

End If

exitHandler:
Application.EnableEvents = True
End Sub

This is the error that comes up when I use the additional code from the sample workbook:

With this VBA the form does not appear and shows the error above. If I remove this and only use:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim rngDV As Range

Dim oldVal As String

Dim newVal As String

Dim strList As String

On Error Resume Next

'temporarily turn off Events

Application.EnableEvents = False

'set a range with all DV cells on sheet

Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)

On Error GoTo exitHandler

'if no DV cells, exit macro

If rngDV Is Nothing Then GoTo exitHandler

If Not Intersect(Target, rngDV) Is Nothing Then

'if active cell IS in DV range

'check if it's a List (DV type 3)

If Target.Validation.Type = 3 Then

'if list, get source list name

strList = Target.Validation.Formula1

strList = Right(strList, Len(strList) - 1)

'pass source list name to global variable

strDVList = strList

'open UserForm

frmDVList.Show

End If

End If



exitHandler:

'turn on Events

Application.EnableEvents = True



End Sub

The form does appear but with no list showing as described earlier. Just in case I wasn't clear enough in my other post.

 

[jessitarexcel]

I haven't written VBA for userforms and listboxes before, so I am sure I am just missing something and it is going to be obvious. Apologies in advance if this is a silly question but I need to learn by this isn't working so I can apply it in the future.

 

[jessitarexcel]

I have resolved this query. I added in the global variable to the module and now it works. That is all I was missing. Will leave this here in case anyone else runs into trouble.

Global [B]strDVList[/B] As String