Multiple Selection From ListBox

[HTSCF Fareha]

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


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!

[gmayor]

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).


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

[HTSCF Fareha]

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?



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!

[gmaxey]

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:


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

[HTSCF Fareha]

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!


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

[gmaxey]

"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.

[HTSCF Fareha]

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

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


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

[gmayor]

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

[HTSCF Fareha]

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?


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...


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

[gmayor]

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?

[HTSCF Fareha]

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?

[gmaxey]

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

[HTSCF Fareha]

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!


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

[HTSCF Fareha]

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

[gmayor]

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
(https://www.gmayor.com/Boiler.htm)
This is way outside the scope of a forum like this.

[HTSCF Fareha]

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.

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.

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!

[gmaxey]

Oops. Change the function as follows:


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

[HTSCF Fareha]

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

[gmaxey]

Sure. Sorry for the confusion.