Multiple Selection From ListBox

Moving on from the ComboBox method, trying to enable selection of more than one from a ListBox is throwing up

Run-Time Error '94': Invalid use of null

Code:

---

Private Sub UserForm_initialize()

Dim myArray    As Variant
    myArray = Split("- Select One Or More -|Requires further investigation|Urgent review|" _
            & "Manageable risk|For Noting Only", "|")
    'Use List method to populate listbox
    ListBox1.List = myArray
    ListBox1.ListIndex = 0
   
'Redefine list for reason for threat level
    'Select threat level
    'Create list of grades for threat
    myArray = Split("- Select -|High|Medium|Low", "|")
    'Use List method to populate listbox
    ComboBox2.List = myArray
    ComboBox2.ListIndex = 0
    'Use List method to populate listbox
    ComboBox3.List = myArray
    ComboBox3.ListIndex = 0
    'Use List method to populate listbox
    ComboBox4.List = myArray
    ComboBox4.ListIndex = 0
    'Use List method to populate listbox
    ComboBox5.List = myArray
    ComboBox5.ListIndex = 0

 lbl_Exit:
    Exit Sub
End Sub


Private Sub ListBox1_Change()
    If ListBox1.ListIndex > 0 Then
        TextBox2.Text = ListBox1.Value
    End If
    Select Case ListBox1.Value
        Case "Requires further investigation":
            TextBox2.Text = "Lorem ipsum dolor sit amet, consectetur adipiscing elit. In rhoncus, lorem et fringilla dictum, orci orci posuere lacus, ut auctor libero neque non purus. Fusce a commodo ligula."
        Case "Urgent review":
            TextBox2.Text = "Proin sed nisl enim. Cras in nisl tempus, scelerisque mi id, vulputate arcu. Duis nec mi ac lorem pretium semper."
        Case "Manageable risk":
            TextBox2.Text = "Fusce eu nisi sollicitudin, pharetra nibh sed, vestibulum neque. Praesent a auctor turpis. Mauris posuere vitae justo ac mollis."
        Case "For Noting Only":
            TextBox2.Text = "Sed eu eros ipsum. Ut posuere id magna eu sollicitudin. Nunc suscipit tempor egestas. Class aptent taciti sociosqu ad litora torquent per conubia nostra, per inceptos himenaeos."
        Case Else
            TextBox2.Text = ""
    End Select
   
lbl_Exit:
    Exit Sub
End Sub

---

I've highlighted where it falls over.

I want to allow the user to be able to select none, one or more from the list (I intend to add more options to the list once this is working).

As an aside, what is the maximum amount of characters I could use for TextBox2.Text ?

Thanks!

Listboxes are not comboboxes and thus require a different approach. It is difficult to understand what you intend to do with multiple selections from your pervious thread (or this one).

Code:

---

Private Sub ListBox1_Click()
Dim i As Long
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            Select Case ListBox1.List(i)
                Case "Requires further investigation":
                    TextBox2.Text = "Lorem ipsum dolor sit amet, consectetur adipiscing elit. In rhoncus, lorem et fringilla dictum, orci orci posuere lacus, ut auctor libero neque non purus. Fusce a commodo ligula."
                Case "Urgent review":
                    TextBox2.Text = "Proin sed nisl enim. Cras in nisl tempus, scelerisque mi id, vulputate arcu. Duis nec mi ac lorem pretium semper."
                Case "Manageable risk":
                    TextBox2.Text = "Fusce eu nisi sollicitudin, pharetra nibh sed, vestibulum neque. Praesent a auctor turpis. Mauris posuere vitae justo ac mollis."
                Case "For Noting Only":
                    TextBox2.Text = "Sed eu eros ipsum. Ut posuere id magna eu sollicitudin. Nunc suscipit tempor egestas. Class aptent taciti sociosqu ad litora torquent per conubia nostra, per inceptos himenaeos."
                Case Else
                    TextBox2.Text = ""
            End Select
        End If
    Next i
lbl_Exit:
    Exit Sub
End Sub

Private Sub UserForm_initialize()

Dim myArray As Variant
    myArray = Split("Requires further investigation|Urgent review|" _
                    & "Manageable risk|For Noting Only", "|")
    TextBox2.MultiLine = True
    TextBox2.ScrollBars = fmScrollBarsVertical
    ListBox1.List = myArray
lbl_Exit:
    Exit Sub
End Sub

---

Thanks, gmayor, this has got the multiple selection part working on. With my limited knowledge of VBA, I assumed that it would be a case of substituting ComboBox for ListBox, albeit with a bit of a tweak here and there.

I'm trying to achieve a form where multiple pieces of text can be displayed in TextBox2 prior to pressing 'Enter' on the UserForm (I've still to add a few options to the ListBox). The code at the moment is only placing one option selected from the ListBox into TextBox2. Is there a way of having say two of the "paragraphs" of text to display in TextBox2 ? How much text can one placed in one of the options? Is there a recognised limit?

Code:

---

Private Sub ListBox1_Change()
    Dim i As Long
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            Select Case ListBox1.List(i)
                Case "Requires further investigation":
                    TextBox2.Text = "Lorem ipsum dolor sit amet, consectetur adipiscing elit. In rhoncus, lorem et fringilla dictum, orci orci posuere lacus, ut auctor libero neque non purus. Fusce a commodo ligula."
                Case "Urgent review":
                    TextBox2.Text = "Proin sed nisl enim. Cras in nisl tempus, scelerisque mi id, vulputate arcu. Duis nec mi ac lorem pretium semper."
                Case "Manageable risk":
                    TextBox2.Text = "Fusce eu nisi sollicitudin, pharetra nibh sed, vestibulum neque. Praesent a auctor turpis. Mauris posuere vitae justo ac mollis."
                Case "For Noting Only":
                    TextBox2.Text = "Sed eu eros ipsum. Ut posuere id magna eu sollicitudin. Nunc suscipit tempor egestas. Class aptent taciti sociosqu ad litora torquent per conubia nostra, per inceptos himenaeos."
                Case Else
                    TextBox2.Text = ""
            End Select
        End If
    Next i
lbl_Exit:
    Exit Sub
End Sub

Private Sub UserForm_initialize()

Dim myArray As Variant
    myArray = Split("Requires further investigation|Urgent review|" _
                    & "Manageable risk|For Noting Only", "|")
    TextBox2.MultiLine = True
    TextBox2.ScrollBars = fmScrollBarsVertical
    ListBox1.List = myArray
lbl_Exit:
    Exit Sub
End Sub

---

Thanks!

Graham must be sleeping or visiting the shops ;-).

You would need to develop an array from the items selected then populate the textbox text with the array elements:

Code:

---

Option Explicit
Private Sub ListBox1_Change()
Dim arrSelected() As String
Dim lngIndex As Long
Dim lngDem As Long
  lngDem = 0
  For lngIndex = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(lngIndex) = True Then
      'Demension the array
      ReDim Preserve arrSelected(lngDem)
      lngDem = lngDem + 1
      Select Case ListBox1.List(lngIndex)
        'If item is selected then add to array.
        Case "Requires further investigation":
          arrSelected(UBound(arrSelected)) = "Lorem ipsum dolor sit amet, consectetur adipiscing elit. In rhoncus, lorem et fringilla dictum, orci orci posuere lacus, ut auctor libero neque non purus. Fusce a commodo ligula."
        Case "Urgent review":
          arrSelected(UBound(arrSelected)) = "Proin sed nisl enim. Cras in nisl tempus, scelerisque mi id, vulputate arcu. Duis nec mi ac lorem pretium semper."
        Case "Manageable risk":
          arrSelected(UBound(arrSelected)) = "Fusce eu nisi sollicitudin, pharetra nibh sed, vestibulum neque. Praesent a auctor turpis. Mauris posuere vitae justo ac mollis."
        Case "For Noting Only":
          arrSelected(UBound(arrSelected)) = "Sed eu eros ipsum. Ut posuere id magna eu sollicitudin. Nunc suscipit tempor egestas. Class aptent taciti sociosqu ad litora torquent per conubia nostra, per inceptos himenaeos."
        Case Else
          arrSelected(UBound(arrSelected)) = ""
      End Select
    End If
  Next lngIndex
  If fcnIsArrayAllocated(arrSelected) Then
    'If array demensioned then develop string.
    TextBox2.Text = fcnArrayToSepPars(arrSelected)
  Else
    TextBox2.Text = vbNullString
  End If
lbl_Exit:
  Exit Sub
End Sub

Private Sub UserForm_initialize()
  With TextBox2
    .MultiLine = True
    .ScrollBars = fmScrollBarsVertical
  End With
  ListBox1.List = Split("Requires further investigation|Urgent review|" _
                    & "Manageable risk|For Noting Only", "|")
lbl_Exit:
  Exit Sub
End Sub

Function fcnIsArrayAllocated(arrPassed As Variant) As Boolean
  'Adapted from method published by Chip Pearson.
  On Error Resume Next
  fcnIsArrayAllocated = IsArray(arrPassed) And Not IsError(LBound(arrPassed, 1)) And LBound(arrPassed, 1) <= UBound(arrPassed, 1)
lbl_Exit:
  Exit Function
End Function

Public Function fcnArrayToSepPars(varIn As Variant) As String
Dim strTemp As String
Dim lngIndex As Long
  Select Case UBound(varIn)
    Case 0: fcnArrayToSepPars = varIn(0)
    Case Else
      fcnArrayToSepPars = varIn(0)
      lngIndex = 0
      Do While lngIndex < UBound(varIn)
        fcnArrayToSepPars = fcnArrayToSepPars & vbCr & vbCr & varIn(lngIndex)
        lngIndex = lngIndex + 1
      Loop
  End Select
lbl_Exit:
  Exit Function
End Function

---

Thanks, Greg.

I hadn't provided all the code, so this still falls over.

How much text can one placed in one of the options? Is there a recognised limit?

Thanks!

Code:

---

Option Explicit

'Cancel button
Private Sub CancelBut_Click()
    Unload Me
End Sub


'Reset button
Private Sub ResetBut_Click()
    Dim ctl        As MSForms.Control
   
    For Each ctl In Controls
        Select Case TypeName(ctl)
            Case "TextBox"
                ctl.Text = ""
            Case "CheckBox", "OptionButton", "ToggleButton"
                ctl.Value = True
            Case "ComboBox", "ListBox"
                ctl.ListIndex = 0
        End Select
    Next ctl
End Sub

'Enter button
Private Sub EnterBut_Click()
    Dim oThreat    As Range, oHarm As Range, oOpportunity As Range
    Dim oRisk      As Range, oReview        As Range, oReason        As Range
   
    'Check required fields are filled out
   
    If TextBox1.Text = "" Then
        MsgBox "Provide Review", vbCritical, "Triage Hub"
        TextBox1.SetFocus
        Exit Sub
    End If
   
    If TextBox2.Text = "" Then
        MsgBox "Provide Reason", vbCritical, "Triage Hub"
        TextBox2.SetFocus
        Exit Sub
    End If
   
    If ComboBox2.ListIndex = 0 Then
        MsgBox "Select threat level", vbCritical, "Triage Hub"
        ComboBox2.SetFocus
        Exit Sub
    End If
   
    If ComboBox3.ListIndex = 0 Then
        MsgBox "Select harm level", vbCritical, "Triage Hub"
        ComboBox3.SetFocus
        Exit Sub
    End If
   
    If ComboBox4.ListIndex = 0 Then
        MsgBox "Select opportunity level", vbCritical, "Triage Hub"
        ComboBox4.SetFocus
        Exit Sub
    End If
   
    If ComboBox5.ListIndex = 0 Then
        MsgBox "Select risk level", vbCritical, "Triage Hub"
        ComboBox5.SetFocus
        Exit Sub
    End If
   
    'use FillBM function to write to bookmarks
    FillBM "Review", TextBox1.Text
    FillBM "Reason", TextBox2.Text
    FillBM "Threat1", TextBox3.Text
    FillBM "Harm1", TextBox4.Text
    FillBM "Opportunity1", TextBox5.Text
    FillBM "Risk1", TextBox6.Text
    FillBM "Threat", ComboBox2.Value, ComboBox2.BackColor
    FillBM "Harm", ComboBox3.Value, ComboBox3.BackColor
    FillBM "Opportunity", ComboBox4.Value, ComboBox4.BackColor
    FillBM "Risk", ComboBox5.Value, ComboBox5.BackColor
   
    Set oThreat = Nothing
    Set oHarm = Nothing
    Set oOpportunity = Nothing
    Set oRisk = Nothing
    Set oReason = Nothing
    Set oReview = Nothing
    Unload Me
lbl_Exit:
    Exit Sub
End Sub

'Change colour of dropdown
Private Sub ComboBox2_Change()
    With ComboBox2
        Select Case .ListIndex
            Case 0: .BackColor = &H80000005: .ForeColor = &H80000008
            Case 1: .BackColor = &HFF&: .ForeColor = &H80000005
            Case 2: .BackColor = &H80FF&: .ForeColor = &H80000005
            Case 3: .BackColor = &H8000&: .ForeColor = &H80000005
        End Select
    End With
lbl_Exit:
    Exit Sub
End Sub

'Change colour of dropdown
Private Sub ComboBox3_Change()
    With ComboBox3
        Select Case .ListIndex
            Case 0: .BackColor = &H80000005: .ForeColor = &H80000008
            Case 1: .BackColor = &HFF&: .ForeColor = &H80000005
            Case 2: .BackColor = &H80FF&: .ForeColor = &H80000005
            Case 3: .BackColor = &H8000&: .ForeColor = &H80000005
        End Select
    End With
lbl_Exit:
    Exit Sub
End Sub

'Change colour of dropdown
Private Sub ComboBox4_Change()
    With ComboBox4
        Select Case .ListIndex
            Case 0: .BackColor = &H80000005: .ForeColor = &H80000008
            Case 1: .BackColor = &HFF&: .ForeColor = &H80000005
            Case 2: .BackColor = &H80FF&: .ForeColor = &H80000005
            Case 3: .BackColor = &H8000&: .ForeColor = &H80000005
        End Select
    End With
lbl_Exit:
    Exit Sub
End Sub

'Change colour of dropdown
Private Sub ComboBox5_Change()
    With ComboBox5
        Select Case .ListIndex
            Case 0: .BackColor = &H80000005: .ForeColor = &H80000008
            Case 1: .BackColor = &HFF&: .ForeColor = &H80000005
            Case 2: .BackColor = &H80FF&: .ForeColor = &H80000005
            Case 3: .BackColor = &H8000&: .ForeColor = &H80000005
        End Select
    End With
lbl_Exit:
    Exit Sub
End Sub


Private Sub ListBox1_Change()
Dim arrSelected() As String
Dim lngIndex As Long
Dim lngDem As Long
  lngDem = 0
  For lngIndex = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(lngIndex) = True Then
      'Dimension the array
      ReDim Preserve arrSelected(lngDem)
      lngDem = lngDem + 1
      Select Case ListBox1.List(lngIndex)
        'If item is selected then add to array.
        Case "Requires further investigation":
          arrSelected(UBound(arrSelected)) = "Lorem ipsum dolor sit amet, consectetur adipiscing elit. In rhoncus, lorem et fringilla dictum, orci orci posuere lacus, ut auctor libero neque non purus. Fusce a commodo ligula."
        Case "Urgent review":
          arrSelected(UBound(arrSelected)) = "Proin sed nisl enim. Cras in nisl tempus, scelerisque mi id, vulputate arcu. Duis nec mi ac lorem pretium semper."
        Case "Manageable risk":
          arrSelected(UBound(arrSelected)) = "Fusce eu nisi sollicitudin, pharetra nibh sed, vestibulum neque. Praesent a auctor turpis. Mauris posuere vitae justo ac mollis."
        Case "For Noting Only":
          arrSelected(UBound(arrSelected)) = "Sed eu eros ipsum. Ut posuere id magna eu sollicitudin. Nunc suscipit tempor egestas. Class aptent taciti sociosqu ad litora torquent per conubia nostra, per inceptos himenaeos."
        Case Else
          arrSelected(UBound(arrSelected)) = ""
      End Select
    End If
  Next lngIndex
  If fcnIsArrayAllocated(arrSelected) Then
    'If array dimensioned then develop string.
    TextBox2.Text = fcnArrayToSepPars(arrSelected)
  Else
    TextBox2.Text = vbNullString
  End If
lbl_Exit:
  Exit Sub
End Sub
    Private Sub UserForm_initialize()
  With TextBox2
    .MultiLine = True
    .ScrollBars = fmScrollBarsVertical
  End With
  ListBox1.List = Split("- Select One Or More -|Requires further investigation|Urgent review|" _
            & "Manageable risk|For Noting Only", "|")
lbl_Exit:
  Exit Sub
End Sub

Function fcnIsArrayAllocated(arrPassed As Variant) As Boolean
  'Adapted from method published by Chip Pearson.
  On Error Resume Next
  fcnIsArrayAllocated = IsArray(arrPassed) And Not IsError(LBound(arrPassed, 1)) And LBound(arrPassed, 1) <= UBound(arrPassed, 1)
lbl_Exit:
  Exit Function
End Function

Public Function fcnArrayToSepPars(varIn As Variant) As String
Dim strTemp As String
Dim lngIndex As Long
  Select Case UBound(varIn)
    Case 0: fcnArrayToSepPars = varIn(0)
    Case Else
      fcnArrayToSepPars = varIn(0)
      lngIndex = 0
      Do While lngIndex < UBound(varIn)
        fcnArrayToSepPars = fcnArrayToSepPars & vbCr & vbCr & varIn(lngIndex)
        lngIndex = lngIndex + 1
      Loop
  End Select
lbl_Exit:
  Exit Function
End Function




Dim myArray()  As String
   
    'Redefine list for reason for threat level
    'Select threat level
    'Create list of grades for threat
    myArray = Split("- Select -|High|Medium|Low", "|")
    'Use List method to populate listbox
    ComboBox2.List = myArray
    ComboBox2.ListIndex = 0
    'Use List method to populate listbox
    ComboBox3.List = myArray
    ComboBox3.ListIndex = 0
    'Use List method to populate listbox
    ComboBox4.List = myArray
    ComboBox4.ListIndex = 0
    'Use List method to populate listbox
    ComboBox5.List = myArray
    ComboBox5.ListIndex = 0
   
lbl_Exit:
    Exit Sub
End Sub


Private Sub FillBM(strbmName As String, strValue As String, Optional lngColor As Long = &H80000005)
    'Graham Mayor - http://www.gmayor.com
    Dim oRng        As Range
    With ActiveDocument
        On Error GoTo lbl_Exit
        If .Bookmarks.Exists(strbmName) = True Then
            Set oRng = .Bookmarks(strbmName).Range
            oRng.Text = strValue
            oRng.Font.Color = lngColor
            oRng.Bookmarks.Add strbmName
        End If
    End With
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
End Sub

---

"This falls over" isn't very helpful. What falls over? Where does it fall?

There is a string limit of 255 characters. Not sure if that is what you are hitting up against or not.

Apologies, that wasn't very helpful. I should have provided more detail.

Getting a 'Compile error: Ambiguous name detected: UserForm_initialize'

Code:

---

Dim myArray()  As String
   
    'Redefine list for reason for threat level
    'Select threat level
    'Create list of grades for threat
    myArray = Split("- Select -|High|Medium|Low", "|")
    'Use List method to populate listbox
    ComboBox2.List = myArray
    ComboBox2.ListIndex = 0
    'Use List method to populate listbox
    ComboBox3.List = myArray
    ComboBox3.ListIndex = 0
    'Use List method to populate listbox
    ComboBox4.List = myArray
    ComboBox4.ListIndex = 0
    'Use List method to populate listbox
    ComboBox5.List = myArray
    ComboBox5.ListIndex = 0
   
lbl_Exit:
    Exit Sub
End Sub

---

Undoubtedly you have two UserForm_initialize macros in the module.You can only have one. Combine them as required.

Absolutely beautiful! Many thanks to both gmayor and gmaxey!!


Only problem left is that when clicking on an option in the ListBox, choosing a single entry is fine. Select another entry too and it will not always pick the correct option, but will put two of the same into TextBox 2. If two options are selected from the ListBox, then two lots of whichever is first in the list order will populate the TextBox.

Will this have anything to do with where I placed this?

Code:

---

Dim myArray()  As String
   
    'Redefine list for reason for threat level
    'Select threat level
    'Create list of grades for threat
    myArray = Split("- Select -|High|Medium|Low", "|")
    'Use List method to populate listbox
    ComboBox2.List = myArray
    ComboBox2.ListIndex = 0
    'Use List method to populate listbox
    ComboBox3.List = myArray
    ComboBox3.ListIndex = 0
    'Use List method to populate listbox
    ComboBox4.List = myArray
    ComboBox4.ListIndex = 0
    'Use List method to populate listbox
    ComboBox5.List = myArray
    ComboBox5.ListIndex = 0
   
lbl_Exit:
    Exit Sub
End Sub

---

This is where I have placed it...

Code:

---

Private Sub UserForm_initialize()
   
    Dim myArray()  As String
   
    'Define list for threat level
    'Select threat level
    'Create list of grades for threat
    myArray = Split("- Select -|High|Medium|Low", "|")
    'Use List method to populate listbox
    ComboBox2.List = myArray
    ComboBox2.ListIndex = 0
    'Use List method to populate listbox
    ComboBox3.List = myArray
    ComboBox3.ListIndex = 0
    'Use List method to populate listbox
    ComboBox4.List = myArray
    ComboBox4.ListIndex = 0
    'Use List method to populate listbox
    ComboBox5.List = myArray
    ComboBox5.ListIndex = 0
   

   
    With TextBox2
        .MultiLine = True
        .ScrollBars = fmScrollBarsVertical
    End With
    ListBox1.List = Split("Requires further investigation|Urgent review|" _
                  & "Manageable risk|For Noting Only", "|")
lbl_Exit:
    Exit Sub
End Sub

---

As I said earlier, you have not indicated the point of multiple selections from the list box. What are you trying to do with them?

I'm trying to achieve a form where multiple pieces of text can be displayed in TextBox2 prior to pressing 'Enter' on the UserForm (I've still to add a few options to the ListBox).

I'm after having say two or three of the "paragraphs" of text (selected as an option from ListBox1) to display in TextBox2 in realtime and in the order that they are selected.

Hope this makes sense?

I've showed you how to do that. What is the problem?

Apologies to you both, as the thread has become confused in responding to each of your replies. Your combined suggestions and code provided is bringing this very close!

I'll try to bring everything together.

The Problem

When clicking on an option in the ListBox1, choosing a single entry is fine, TextBox2 is populated accordingly. Select another entry too and it will not always pick the correct option, but will put two of the same into TextBox 2. If two options are selected from the ListBox1, then two lots of whichever is first in the list order will populate the TextBox2.

My Aim

I'm after having say two or three of the "paragraphs" of text (selected as an option from ListBox1) to display in TextBox2 in realtime and in the order that they are selected.

What Do I Think Might Be Causing This?

I was wondering if where I placed the code for ComboBox 2 through ComboBox 5 (as per post #9)

What Does The Code Look Like At This Time

Here is my code at this moment.

Thanks!

Code:

---

Option Explicit

'Cancel button
Private Sub CancelBut_Click()
    Unload Me
End Sub


'Reset button
Private Sub ResetBut_Click()
    Dim ctl        As MSForms.Control
   
    For Each ctl In Controls
        Select Case TypeName(ctl)
            Case "TextBox"
                ctl.Text = ""
            Case "CheckBox", "OptionButton", "ToggleButton"
                ctl.Value = True
            Case "ComboBox", "ListBox"
                ctl.ListIndex = 0
        End Select
    Next ctl
End Sub

'Enter button
Private Sub EnterBut_Click()
    Dim oThreat    As Range, oHarm As Range, oOpportunity As Range
    Dim oRisk      As Range, oReview        As Range, oReason        As Range
   
    'Check required fields are filled out
   
    If TextBox1.Text = "" Then
        MsgBox "Provide Review", vbCritical, "Triage Hub"
        TextBox1.SetFocus
        Exit Sub
    End If
   
    If TextBox2.Text = "" Then
        MsgBox "Provide Reason", vbCritical, "Triage Hub"
        TextBox2.SetFocus
        Exit Sub
    End If
   
    If ComboBox2.ListIndex = 0 Then
        MsgBox "Select threat level", vbCritical, "Triage Hub"
        ComboBox2.SetFocus
        Exit Sub
    End If
   
    If ComboBox3.ListIndex = 0 Then
        MsgBox "Select harm level", vbCritical, "Triage Hub"
        ComboBox3.SetFocus
        Exit Sub
    End If
   
    If ComboBox4.ListIndex = 0 Then
        MsgBox "Select opportunity level", vbCritical, "Triage Hub"
        ComboBox4.SetFocus
        Exit Sub
    End If
   
    If ComboBox5.ListIndex = 0 Then
        MsgBox "Select risk level", vbCritical, "Triage Hub"
        ComboBox5.SetFocus
        Exit Sub
    End If
   
    'use FillBM function to write to bookmarks
    FillBM "Review", TextBox1.Text
    FillBM "Reason", TextBox2.Text
    FillBM "Threat1", TextBox3.Text
    FillBM "Harm1", TextBox4.Text
    FillBM "Opportunity1", TextBox5.Text
    FillBM "Risk1", TextBox6.Text
    FillBM "Threat", ComboBox2.Value, ComboBox2.BackColor
    FillBM "Harm", ComboBox3.Value, ComboBox3.BackColor
    FillBM "Opportunity", ComboBox4.Value, ComboBox4.BackColor
    FillBM "Risk", ComboBox5.Value, ComboBox5.BackColor
   
    Set oThreat = Nothing
    Set oHarm = Nothing
    Set oOpportunity = Nothing
    Set oRisk = Nothing
    Set oReason = Nothing
    Set oReview = Nothing
    Unload Me
lbl_Exit:
    Exit Sub
End Sub

'Change colour of dropdown
Private Sub ComboBox2_Change()
    With ComboBox2
        Select Case .ListIndex
            Case 0: .BackColor = &H80000005: .ForeColor = &H80000008
            Case 1: .BackColor = &HFF&: .ForeColor = &H80000005
            Case 2: .BackColor = &H80FF&: .ForeColor = &H80000005
            Case 3: .BackColor = &H8000&: .ForeColor = &H80000005
        End Select
    End With
lbl_Exit:
    Exit Sub
End Sub

'Change colour of dropdown
Private Sub ComboBox3_Change()
    With ComboBox3
        Select Case .ListIndex
            Case 0: .BackColor = &H80000005: .ForeColor = &H80000008
            Case 1: .BackColor = &HFF&: .ForeColor = &H80000005
            Case 2: .BackColor = &H80FF&: .ForeColor = &H80000005
            Case 3: .BackColor = &H8000&: .ForeColor = &H80000005
        End Select
    End With
lbl_Exit:
    Exit Sub
End Sub

'Change colour of dropdown
Private Sub ComboBox4_Change()
    With ComboBox4
        Select Case .ListIndex
            Case 0: .BackColor = &H80000005: .ForeColor = &H80000008
            Case 1: .BackColor = &HFF&: .ForeColor = &H80000005
            Case 2: .BackColor = &H80FF&: .ForeColor = &H80000005
            Case 3: .BackColor = &H8000&: .ForeColor = &H80000005
        End Select
    End With
lbl_Exit:
    Exit Sub
End Sub

'Change colour of dropdown
Private Sub ComboBox5_Change()
    With ComboBox5
        Select Case .ListIndex
            Case 0: .BackColor = &H80000005: .ForeColor = &H80000008
            Case 1: .BackColor = &HFF&: .ForeColor = &H80000005
            Case 2: .BackColor = &H80FF&: .ForeColor = &H80000005
            Case 3: .BackColor = &H8000&: .ForeColor = &H80000005
        End Select
    End With
lbl_Exit:
    Exit Sub
End Sub


Private Sub ListBox1_Change()
Dim arrSelected() As String
Dim lngIndex As Long
Dim lngDem As Long
  lngDem = 0
  For lngIndex = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(lngIndex) = True Then
      'Dimension the array
      ReDim Preserve arrSelected(lngDem)
      lngDem = lngDem + 1
      Select Case ListBox1.List(lngIndex)
        'If item is selected then add to array.
        Case "Requires further investigation":
          arrSelected(UBound(arrSelected)) = "Lorem ipsum dolor sit amet, consectetur adipiscing elit. In rhoncus, lorem et fringilla dictum, orci orci posuere lacus, ut auctor libero neque non purus. Fusce a commodo ligula."
        Case "Urgent review":
          arrSelected(UBound(arrSelected)) = "Proin sed nisl enim. Cras in nisl tempus, scelerisque mi id, vulputate arcu. Duis nec mi ac lorem pretium semper."
        Case "Manageable risk":
          arrSelected(UBound(arrSelected)) = "Fusce eu nisi sollicitudin, pharetra nibh sed, vestibulum neque. Praesent a auctor turpis. Mauris posuere vitae justo ac mollis."
        Case "For Noting Only":
          arrSelected(UBound(arrSelected)) = "Sed eu eros ipsum. Ut posuere id magna eu sollicitudin. Nunc suscipit tempor egestas. Class aptent taciti sociosqu ad litora torquent per conubia nostra, per inceptos himenaeos."
        Case Else
          arrSelected(UBound(arrSelected)) = ""
      End Select
    End If
  Next lngIndex
  If fcnIsArrayAllocated(arrSelected) Then
    'If array dimensioned then develop string.
    TextBox2.Text = fcnArrayToSepPars(arrSelected)
  Else
    TextBox2.Text = vbNullString
  End If
lbl_Exit:
  Exit Sub
End Sub
    Private Sub UserForm_initialize()
   
    Dim myArray()  As String
   
    'Define list for threat level
    'Select threat level
    'Create list of grades for threat
    myArray = Split("- Select -|High|Medium|Low", "|")
    'Use List method to populate listbox
    ComboBox2.List = myArray
    ComboBox2.ListIndex = 0
    'Use List method to populate listbox
    ComboBox3.List = myArray
    ComboBox3.ListIndex = 0
    'Use List method to populate listbox
    ComboBox4.List = myArray
    ComboBox4.ListIndex = 0
    'Use List method to populate listbox
    ComboBox5.List = myArray
    ComboBox5.ListIndex = 0
   

    With TextBox2
        .MultiLine = True
        .ScrollBars = fmScrollBarsVertical
    End With
    ListBox1.List = Split("Requires further investigation|Urgent review|" _
                  & "Manageable risk|For Noting Only", "|")
lbl_Exit:
    Exit Sub
End Sub

Function fcnIsArrayAllocated(arrPassed As Variant) As Boolean
  'Adapted from method published by Chip Pearson.
  On Error Resume Next
  fcnIsArrayAllocated = IsArray(arrPassed) And Not IsError(LBound(arrPassed, 1)) And LBound(arrPassed, 1) <= UBound(arrPassed, 1)
lbl_Exit:
  Exit Function
End Function

Public Function fcnArrayToSepPars(varIn As Variant) As String
Dim strTemp As String
Dim lngIndex As Long
  Select Case UBound(varIn)
    Case 0: fcnArrayToSepPars = varIn(0)
    Case Else
      fcnArrayToSepPars = varIn(0)
      lngIndex = 0
      Do While lngIndex < UBound(varIn)
        fcnArrayToSepPars = fcnArrayToSepPars & vbCr & vbCr & varIn(lngIndex)
        lngIndex = lngIndex + 1
      Loop
  End Select
lbl_Exit:
  Exit Function
End Function


Private Sub FillBM(strbmName As String, strValue As String, Optional lngColor As Long = &H80000005)
    'Graham Mayor - http://www.gmayor.com
    Dim oRng        As Range
    With ActiveDocument
        On Error GoTo lbl_Exit
        If .Bookmarks.Exists(strbmName) = True Then
            Set oRng = .Bookmarks(strbmName).Range
            oRng.Text = strValue
            oRng.Font.Color = lngColor
            oRng.Bookmarks.Add strbmName
        End If
    End With
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
End Sub

---

Forgive my lack of knowledge with VBA, but would some sort of unique identifier applied to each of the options work?

What you are proposing is extremely complicated and doesn't seem to fulfil any useful purpose. List boxes don't work as you anticipate.

What you should be doing is creating a second list box and a button to copy from one to the other then provide sort options to sort the second list box - see https://www.gmayor.com/photo_gallery_template.html or https://www.gmayor.com/Boiler.htm

This is way outside the scope of a forum like this.

Although I have little knowledge of VBA and bow to your wealth of knowledge on the subject, it would appear from the results that I am getting that gmaxey's suggestion is not far off.

Attachment 27021

The first screen capture shows what is obtained if all the options in ListBox1 are selected (results appear as required in TextBox2). You will note that the first selection (or the one highest up the list if less is selected (see second screen capture)) from ListBox1 is repeated each time.

Attachment 27022

If I leave out the wish for the items to be shown in TextBox2 as they are selected from ListBox1, is what I request still possible?

Thanks!

Oops. Change the function as follows:

Code:

---

Public Function fcnArrayToSepPars(varIn As Variant) As String
Dim strTemp As String
Dim lngIndex As Long
  Select Case UBound(varIn)
    Case 0: fcnArrayToSepPars = varIn(0)
    Case Else
      fcnArrayToSepPars = varIn(0)
      lngIndex = 1
      Do While lngIndex <= UBound(varIn)
        fcnArrayToSepPars = fcnArrayToSepPars & vbCr & vbCr & varIn(lngIndex)
        lngIndex = lngIndex + 1
      Loop
  End Select
lbl_Exit:
  Exit Function
End Function

---

Brilliant, many thanks gmaxey! That's solved it!!

Sure. Sorry for the confusion.