TechQA.

Linked Questions

Popular Questions

VBA: Error handling when pasting multiselect listbox values to cell

Asked by At

I need help improving code or if my code is already pretty good, I'd be interested in alternative ways to do it.

What I want to do: In Excel, I have a userform in which the user types people's name, age, hair color etc. (one person at a time). For something like hair color, I have given 5 pre-defined choices in a listbox and since people can change hair color, multiselect is enabled. The selected hair color (one or multiple) is then pasted to a specific cell.

Problem: I've struggled a bit with error handling when the user forgets to choose a hair color.

Working code: I did get it to work with the following code 

Private Sub cmdSubmit_Click()
  Dim cnt As Long
  Dim LastRow As Long
  Dim s As String
  Dim i As Integer

  With Me.lbxHair
    For i = 0 To .ListCount - 1
        If .Selected(i) = True Then
            s = s & .List(i) & ","
            cnt = cnt + 1
        End If
    Next i
  End With

  If cnt = 0 Then
    MsgBox "No hair color selected"
    Exit Sub
  Else
    Cells(LastRow + 1, 1).Value = Me.tbxName.Value
    Me.tbxName.Value = ""
    Me.tbxName.SetFocus

    Range("B" & LastRow + 1).Value = Left(s, Len(s) - 1)
    On Error Resume Next
  End If

End Sub

This is perfectly fine for my purposes, but is there a way to do it without the auxiliary cnt-Variable? I tried this because I've read .ListIndex = -1 means nothing is selected

Non-working code (same variable declaration as above):

With Me.lbxHair
    If .ListIndex = -1 Then
        MsgBox "No hair color selected"
        Exit Sub
    Else
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then s = s & .List(i) & ","
        Next i
    End If
End With

    Cells(LastRow + 1, 1).Value = Me.tbxName.Value
    Me.tbxName.Value = ""
    Me.tbxName.SetFocus
    Range("B" & LastRow + 1).Value = Left(s, Len(s) - 1)
    On Error Resume Next

When trying to not select anything, I get "Run time error '5': Invalid procedure call or argument"

Why? Also, do you have any other suggestions how I could go about this or how I could improve my code?

excel vba
Original Q&A

1 Answers

0
Tim Williams On

You can try something like this:

Private Sub cmdSubmit_Click()

  Dim LastRow As Long
  Dim s As String, sep As String
  Dim i As Integer

  With Me.lbxHair
    For i = 0 To .ListCount - 1
        If .Selected(i) = True Then
            s = s & sep & .List(i)
            sep = ","
        End If
    Next i
  End With

  If Len(s) = 0 Then
    MsgBox "No hair color selected"
    Exit Sub
  Else
    Cells(LastRow + 1, 1).Value = Me.tbxName.Value
    Cells(LastRow + 1, 2).Value = s
    Me.tbxName.Value = ""
    Me.tbxName.SetFocus

  End If

End Sub

Related Questions