Consulting

Results 1 to 19 of 19

Thread: Multiple Selection From ListBox

  1. #1
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location

    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

    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!
    Last edited by HTSCF Fareha; 08-23-2020 at 03:06 AM.

  2. #2
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    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!

  4. #4
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

  5. #5
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    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
    Last edited by HTSCF Fareha; 08-23-2020 at 01:37 PM.

  6. #6
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    "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.
    Greg

    Visit my website: http://gregmaxey.com

  7. #7
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    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

  8. #8
    Undoubtedly you have two UserForm_initialize macros in the module.You can only have one. Combine them as required.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  9. #9
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    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
    Last edited by HTSCF Fareha; 08-24-2020 at 11:10 AM.

  10. #10
    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?
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  11. #11
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    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?

  12. #12
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    I've showed you how to do that. What is the problem?
    Greg

    Visit my website: http://gregmaxey.com

  13. #13
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    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

  14. #14
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Forgive my lack of knowledge with VBA, but would some sort of unique identifier applied to each of the options work?

  15. #15
    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.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  16. #16
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    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.

    2020-08-28_162251.jpg

    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.

    2020-08-28_162825.jpg

    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!

  17. #17
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

  18. #18
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Brilliant, many thanks gmaxey! That's solved it!!

  19. #19
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    Sure. Sorry for the confusion.
    Greg

    Visit my website: http://gregmaxey.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •