View Single Post
 
Old 01-26-2020, 10:44 AM
gmaxey gmaxey is offline Windows 10 Office 2016
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,429
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

ashbee,


Personally, I prefer list written out as a statement to be comma separated and the last item separated with " and ". I don't know why you used a function to return a string and then that string wasn't used.

Here is a revision to the code and the document is attached.

Code:
Public Sub SelectItems(oCC As ContentControl)
Dim oFrm As frmSelect
Dim arrText() As String, strText As String
Dim lngList As Long, lngItem As Long, lngSelected As Long
Dim arrList() As String
  Set oFrm = New frmSelect
  With oFrm
    .ListBox1.AddItem "Wheelchair Access"
    .ListBox1.AddItem "Note Taker"
    .ListBox1.AddItem "No"
    If Not oCC.ShowingPlaceholderText Then
      strText = Replace(oCC.Range.Text, ", ", "~")
      strText = Replace(strText, " and ", "~")
      arrList = Split(strText, "~")
      For lngItem = 0 To UBound(arrList)
        For lngList = lngItem To .ListBox1.ListCount - 1
          If .ListBox1.List(lngList) = Trim(arrList(lngItem)) Then
            .ListBox1.Selected(lngList) = True
          End If
        Next lngList
      Next lngItem
    End If
    .show
    If .Tag = 0 Then
      GoTo lbl_Exit
    Else
      ReDim arrText(0)
      For lngList = 0 To .ListBox1.ListCount - 1
        If .ListBox1.Selected(lngList) Then
          ReDim Preserve arrText(lngList)
          arrText(lngList) = .ListBox1.List(lngList)
          lngSelected = lngSelected + 1
        End If
      Next lngList
      Select Case UBound(arrText)
        Case 0
          strText = arrText(0)
        Case 1
          strText = arrText(0) & " and " & arrText(1)
        Case Else
          For lngList = 0 To UBound(arrText) - 1
            If lngList = 0 Then
              strText = arrText(lngList)
            Else
              strText = strText & ", " & arrText(lngList)
            End If
          Next lngList
          strText = strText & " and " & arrText(UBound(arrText))
      End Select
      oCC.Range.Text = strText
    End If
  End With
lbl_Exit:
  Unload oFrm
  Set oFrm = Nothing: Set oCC = Nothing
  Exit Sub
End Sub
Attached Files
File Type: docm multiselect userform.docm (87.1 KB, 9 views)
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote