Consulting

Page 1 of 3 1 2 3 LastLast
Results 1 to 20 of 53

Thread: Selecting a team from a ListBox

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

    Selecting a team from a ListBox

    I have a simple form that allows for the selection of team members to be assigned to a work task.

    My form has a ComboBox which allows for selection of either Team 1, Team 2 or Team 3.

    Depending on the selection, I then have a ListBox with members associated with the team selected. The form user will then select multiple names from this ListBox, to be transferred to a TextBox prior to the ‘Enter’ button being pressed to fill in the names at the correct place in the form via a Bookmark. The reason for the need for the TextBox to be populated prior to the enter button is to allow for the form user to manually add names that are not members of any of the three teams.

    My form at the moment only works as far as allowing for a selection from the ComboBox. Not a very good start really!

    Help would be very much appreciated, thanks.

    Option Explicit
    
    Private Sub EnterBut_Click()
        Dim oTeamMembers As Range
        
        'Check if a team has been selected
        If ComboBox1.ListIndex = 0 Then
            MsgBox "Select Team", vbCritical, "Triage Hub"
            ComboBox1.SetFocus
            Exit Sub
        End If
        
        'Check if team members have been selected
        If TextBox1.Text = "" Then
            MsgBox "Select Team Members", vbCritical, "Triage Hub"
            TextBox1.SetFocus
            Exit Sub
        End If
        
        'use FillBM function to write bookmarks
        FillBM "TeamMembers", TextBox1.Text
        
        Set oTeamMembers = Nothing
        Unload Me
        lbl_Exit
        Exit Sub
        
    End Sub
    
    Private Sub UserForm_Initialize()
        Dim myArray()   As String
        
        'Create list of teams
        myArray = Split("Select Team|Team 1|Team 2|Team 3", "|")
        
        'Use List method to populate ComboBox
        ComboBox1.List = myArray
        ComboBox1.ListIndex = 0
        
        'Redefine list for team members Team 1
        myArray = Split("Select Team Members Team 1|Dave|Rob|Sarah|Dave|Rob|Sarah|Liz|Mike", "|")
    
        'Redefine list for team members Team 2
        myArray = Split("Select Team Members Team 2|Mike|June|Mary|John|Steve|Maria|Liz|Andy", "|")
    
        'Redefine list for team members Team 3
        myArray = Split("Select Team Members Team 3|Steve|John|Mary|Ivan|Dan|Lisa|Ian|Joan", "|")
        
        lbl_Exit:
        Exit Sub
    End Sub
    
    Private Sub ListBox1_Change()
        If ListBox1.ListIndex > 0 Then
            TextBox1.Text = ListBox1.Value
        End If
        
    End Sub
    
    Private Sub FillBM(strbmName As String, strValue As String)
        '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.Bookmarks.Add strbmName
            End If
        End With
        lbl_Exit:
        Set oRng = Nothing
        Exit Sub
    End Sub

  2. #2
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    Not very elegant, but should work:
    Option Explicit
    Dim myArray()   As String
    
    Private Sub ComboBox1_Change()
      Select Case ComboBox1.ListIndex
        Case 0
          ListBox1.Clear
          
        Case 1
            'Redefine list for team members Team 1
        myArray = Split("Select Team Members Team 1|Dave|Rob|Sarah|Dave|Rob|Sarah|Liz|Mike", "|")
    ListBox1.List = myArray
        Case 2
            'Redefine list for team members Team 2
        myArray = Split("Select Team Members Team 2|Mike|June|Mary|John|Steve|Maria|Liz|Andy", "|")
    ListBox1.List = myArray
    
    
        Case 3
            'Redefine list for team members Team 3
        myArray = Split("Select Team Members Team 3|Steve|John|Mary|Ivan|Dan|Lisa|Ian|Joan", "|")
    ListBox1.List = myArray
    
      End Select
      
    
    End Sub
    
    Private Sub UserForm_Initialize()
    
      'Create list of teams
      myArray = Split("Select Team|Team 1|Team 2|Team 3", "|")
      'Use List method to populate ComboBox
      ComboBox1.List = myArray
      ComboBox1.ListIndex = 0
      ListBox1.MultiSelect = fmMultiSelectMulti
        
    lbl_Exit:
        Exit Sub
    End Sub
    
    Private Sub ListBox1_Change()
    Dim lngIndex As Long, lngCOunt As Long
    Dim arrTMs() As String
      lngCOunt = 0
      For lngIndex = 1 To ListBox1.ListCount - 1
        If ListBox1.Selected(lngIndex) Then
          ReDim Preserve arrTMs(lngCOunt)
          lngCOunt = lngCOunt + 1
          arrTMs(UBound(arrTMs)) = ListBox1.List(lngIndex)
        End If
      Next lngIndex
      If IsArray(arrTMs) Then TextBox1 = fcnArrayToCommaAndDelimtedList(arrTMs)
    End Sub
    
    '**** Create a Comma/And delimited list.
    Public Function fcnArrayToCommaAndDelimtedList(varIn As Variant, Optional bOxford As Boolean = False) As String
    Dim strTemp As String
    Dim lngIndex As Long
      On Error GoTo lbl_Exit
      Select Case UBound(varIn)
        Case 0: fcnArrayToCommaAndDelimtedList = varIn(0)
        Case 1: fcnArrayToCommaAndDelimtedList = varIn(0) & " and " & varIn(1)
        Case Else
          fcnArrayToCommaAndDelimtedList = varIn(0)
          lngIndex = 1
          Do While lngIndex < UBound(varIn)
            fcnArrayToCommaAndDelimtedList = fcnArrayToCommaAndDelimtedList & ", " & varIn(lngIndex)
            lngIndex = lngIndex + 1
          Loop
          If bOxford Then
            fcnArrayToCommaAndDelimtedList = fcnArrayToCommaAndDelimtedList & ", and " & varIn(lngIndex)
          Else
            fcnArrayToCommaAndDelimtedList = fcnArrayToCommaAndDelimtedList & " and " & varIn(lngIndex)
          End If
      End Select
    lbl_Exit:
      Exit Function
    End Function
    Greg

    Visit my website: http://gregmaxey.com

  3. #3
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Thanks for taking a look at this, Greg. Unfortunately this doesn't work. There are no errors, just a blank ComboBox1 for starters.

    Option Explicit
    
    Private Sub EnterBut_Click()
        Dim oTeamMembers As Range
        
        'Check if a team has been selected
        If ComboBox1.ListIndex = 0 Then
            MsgBox "Select Team", vbCritical, "Triage Hub"
            ComboBox1.SetFocus
            Exit Sub
        End If
        
        'Check if team members have been selected
        If TextBox1.Text = "" Then
            MsgBox "Select Team Members", vbCritical, "Triage Hub"
            TextBox1.SetFocus
            Exit Sub
        End If
        
        'use FillBM function to write bookmarks
        FillBM "TeamMembers", TextBox1.Text
        
        Set oTeamMembers = Nothing
        Unload Me
        lbl_Exit
        Exit Sub
        
    End Sub
    
    Option Explicit
    Dim myArray() As String
    
    Private Sub ComboBox1_Change()
        Select Case ComboBox1.ListIndex
            Case 0
                ListBox1.Clear
                
            Case 1
                'Redefine list for team members Team 1
                myArray = Split("Select Team Members Team 1|Dave|Rob|Sarah|Dave|Rob|Sarah|Liz|Mike", "|")
                ListBox1.List = myArray
            Case 2
                'Redefine list for team members Team 2
                myArray = Split("Select Team Members Team 2|Mike|June|Mary|John|Steve|Maria|Liz|Andy", "|")
                ListBox1.List = myArray
                
            Case 3
                'Redefine list for team members Team 3
                myArray = Split("Select Team Members Team 3|Steve|John|Mary|Ivan|Dan|Lisa|Ian|Joan", "|")
                ListBox1.List = myArray
                
        End Select
        
    End Sub
    
    Private Sub ListBox1_Change()
        Dim lngIndex As Long, lngCOunt As Long
        Dim arrTMs() As String
        lngCOunt = 0
        For lngIndex = 1 To ListBox1.ListCount - 1
            If ListBox1.Selected(lngIndex) Then
                ReDim Preserve arrTMs(lngCOunt)
                lngCOunt = lngCOunt + 1
                arrTMs(UBound(arrTMs)) = ListBox1.List(lngIndex)
            End If
        Next lngIndex
        If IsArray(arrTMs) Then TextBox1 = fcnArrayToCommaAndDelimtedList(arrTMs)
    End Sub
    
    '**** Create a Comma/And delimited list.
    Public Function fcnArrayToCommaAndDelimtedList(varIn As Variant, Optional bOxford As Boolean = False) As String
        Dim strTemp As String
        Dim lngIndex As Long
        On Error GoTo lbl_Exit
        Select Case UBound(varIn)
            Case 0: fcnArrayToCommaAndDelimtedList = varIn(0)
            Case 1: fcnArrayToCommaAndDelimtedList = varIn(0) & " And " & varIn(1)
            Case Else
                fcnArrayToCommaAndDelimtedList = varIn(0)
                lngIndex = 1
                Do While lngIndex < UBound(varIn)
                    fcnArrayToCommaAndDelimtedList = fcnArrayToCommaAndDelimtedList & ", " & varIn(lngIndex)
                    lngIndex = lngIndex + 1
                Loop
                If bOxford Then
                    fcnArrayToCommaAndDelimtedList = fcnArrayToCommaAndDelimtedList & ", And " & varIn(lngIndex)
                Else
                    fcnArrayToCommaAndDelimtedList = fcnArrayToCommaAndDelimtedList & " And " & varIn(lngIndex)
                End If
        End Select
    lbl_Exit:
        Exit Function
    End Function
    
    Private Sub FillBM(strbmName As String, strValue As String)
        '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.Bookmarks.Add strbmName
            End If
        End With
    lbl_Exit:
        Set oRng = Nothing
        Exit Sub
    End Sub

  4. #4
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    Your code would not even compile. You have two Option Explicit statements and you have no code to populate the combobox.
    Greg

    Visit my website: http://gregmaxey.com

  5. #5
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    I'm embarassed that I had two Option Explicit statements. I'm learning but have been told this before .

    I've added a ComboBox to list the three teams, although now I have a 'Variable not defined' here:-

    Private Sub ComboBox1_Change()
    I'm sure I'm doing something silly to get this error.

    Option Explicit
    
    Private Sub EnterBut_Click()
        Dim oTeamMembers As Range
        
        'Check if a team has been selected
        If ComboBox1.ListIndex = 0 Then
            MsgBox "Select Team", vbCritical, "Triage Hub"
            ComboBox1.SetFocus
            Exit Sub
        End If
        
        'Check if team members have been selected
        If TextBox1.Text = "" Then
            MsgBox "Select Team Members", vbCritical, "Triage Hub"
            TextBox1.SetFocus
            Exit Sub
        End If
        
        'use FillBM function to write bookmarks
        FillBM "TeamMembers", TextBox1.Text
        
        Set oTeamMembers = Nothing
        Unload Me
        lbl_Exit
        Exit Sub
        
    End Sub
    
    Private Sub ComboBox1_Change()
        Select Case ComboBox1.ListIndex
            Case 0
                ListBox1.Clear
                
            Case 1
                'Redefine list for team members Team 1
                myArray = Split("Select Team Members Team 1|Dave|Rob|Sarah|Dave|Rob|Sarah|Liz|Mike", "|")
                ListBox1.List = myArray
            Case 2
                'Redefine list for team members Team 2
                myArray = Split("Select Team Members Team 2|Mike|June|Mary|John|Steve|Maria|Liz|Andy", "|")
                ListBox1.List = myArray
                
            Case 3
                'Redefine list for team members Team 3
                myArray = Split("Select Team Members Team 3|Steve|John|Mary|Ivan|Dan|Lisa|Ian|Joan", "|")
                ListBox1.List = myArray
                
        End Select
        
    End Sub
    
    Private Sub ListBox1_Change()
        Dim lngIndex    As Long, lngCOunt As Long
        Dim arrTMs()    As String
        lngCOunt = 0
        For lngIndex = 1 To ListBox1.ListCount - 1
            If ListBox1.Selected(lngIndex) Then
                ReDim Preserve arrTMs(lngCOunt)
                lngCOunt = lngCOunt + 1
                arrTMs(UBound(arrTMs)) = ListBox1.List(lngIndex)
            End If
        Next lngIndex
        If IsArray(arrTMs) Then TextBox1 = fcnArrayToCommaAndDelimtedList(arrTMs)
    End Sub
    
    '**** Create a Comma/And delimited list.
    Public Function fcnArrayToCommaAndDelimtedList(varIn As Variant, Optional bOxford As Boolean = False) As String
        Dim strTemp     As String
        Dim lngIndex    As Long
        On Error GoTo lbl_Exit
        Select Case UBound(varIn)
            Case 0: fcnArrayToCommaAndDelimtedList = varIn(0)
            Case 1: fcnArrayToCommaAndDelimtedList = varIn(0) & " And " & varIn(1)
            Case Else
                fcnArrayToCommaAndDelimtedList = varIn(0)
                lngIndex = 1
                Do While lngIndex < UBound(varIn)
                    fcnArrayToCommaAndDelimtedList = fcnArrayToCommaAndDelimtedList & ", " & varIn(lngIndex)
                    lngIndex = lngIndex + 1
                Loop
                If bOxford Then
                    fcnArrayToCommaAndDelimtedList = fcnArrayToCommaAndDelimtedList & ", And " & varIn(lngIndex)
                Else
                    fcnArrayToCommaAndDelimtedList = fcnArrayToCommaAndDelimtedList & " And " & varIn(lngIndex)
                End If
        End Select
    lbl_Exit:
        Exit Function
    End Function
    
    Private Sub UserForm_Initialize()
        Dim myArray()   As String
        'Create list of teams
        myArray = Split("- Select -|Team 1|Team 2|Team 3", "|")
        'Use List method to populate ComboBox
        ComboBox1.List = myArray
        ComboBox1.ListIndex = 0
    lbl_Exit:
        Exit Sub
    End Sub
    
    Private Sub FillBM(strbmName As String, strValue As String)
        '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.Bookmarks.Add strbmName
            End If
        End With
    lbl_Exit:
        Set oRng = Nothing
        Exit Sub
    End Sub

  6. #6
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    You might try declaring your myArray variable at the module level like I showed you in my first reply. When you use the Option Explicit statement (once), you "MUST" declare variables.

    Option Explicit
    Dim myArray() As String
    Greg

    Visit my website: http://gregmaxey.com

  7. #7
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Okay, I've put the variables at the top.

    The ComboBox allows the selection of Team 1, Team 2 or Team 3, which populates the ListBox with the correct names for the respective team. But it will only allow for the selection of one of the names (which is transferred to the TextBox), rather than multiple selection.

    Pressing the 'Enter' button also gives a compile error - sub or function not defined here:-

    Private Sub EnterBut_Click()
    Here is my revised code.

    Option Explicit
    
    Dim oTeamMembers As Range
    Dim myArray() As String
    
    Private Sub ComboBox1_Change()
        Select Case ComboBox1.ListIndex
            Case 0
                ListBox1.Clear
                
            Case 1
                'Redefine list for team members Team 1
                myArray = Split("Dave|Rob|Sarah|Dave|Rob|Sarah|Liz|Mike", "|")
                ListBox1.List = myArray
            Case 2
                'Redefine list for team members Team 2
                myArray = Split("Mike|June|Mary|John|Steve|Maria|Liz|Andy", "|")
                ListBox1.List = myArray
                
            Case 3
                'Redefine list for team members Team 3
                myArray = Split("Steve|John|Mary|Ivan|Dan|Lisa|Ian|Joan", "|")
                ListBox1.List = myArray
                
        End Select
        
    End Sub
    
    Private Sub ListBox1_Change()
        Dim lngIndex As Long, lngCOunt As Long
        Dim arrTMs() As String
        lngCOunt = 0
        For lngIndex = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(lngIndex) Then
                ReDim Preserve arrTMs(lngCOunt)
                lngCOunt = lngCOunt + 1
                arrTMs(UBound(arrTMs)) = ListBox1.List(lngIndex)
            End If
        Next lngIndex
        If IsArray(arrTMs) Then TextBox1 = fcnArrayToCommaAndDelimtedList(arrTMs)
    End Sub
    
    '**** Create a Comma/And delimited list.
    Public Function fcnArrayToCommaAndDelimtedList(varIn As Variant, Optional bOxford As Boolean = False) As String
        Dim strTemp As String
        Dim lngIndex As Long
        On Error GoTo lbl_Exit
        Select Case UBound(varIn)
            Case 0: fcnArrayToCommaAndDelimtedList = varIn(0)
            Case 1: fcnArrayToCommaAndDelimtedList = varIn(0) & " And " & varIn(1)
            Case Else
                fcnArrayToCommaAndDelimtedList = varIn(0)
                lngIndex = 1
                Do While lngIndex < UBound(varIn)
                    fcnArrayToCommaAndDelimtedList = fcnArrayToCommaAndDelimtedList & ", " & varIn(lngIndex)
                    lngIndex = lngIndex + 1
                Loop
                If bOxford Then
                    fcnArrayToCommaAndDelimtedList = fcnArrayToCommaAndDelimtedList & ", And " & varIn(lngIndex)
                Else
                    fcnArrayToCommaAndDelimtedList = fcnArrayToCommaAndDelimtedList & " And " & varIn(lngIndex)
                End If
        End Select
    lbl_Exit:
        Exit Function
    End Function
    
    'Enter button
    Private Sub EnterBut_Click()
        
        'Check if a team has been selected
        If ComboBox1.ListIndex = 0 Then
            MsgBox "Select Team", vbCritical, "Triage Hub"
            ComboBox1.SetFocus
            Exit Sub
        End If
        
        'Check if team members have been selected
        If TextBox1.Text = "" Then
            MsgBox "Select Team Members", vbCritical, "Triage Hub"
            TextBox1.SetFocus
            Exit Sub
        End If
        
        'use FillBM function to write bookmarks
        FillBM "TeamMembers", TextBox1.Text
        
        Set oTeamMembers = Nothing
        Unload Me
        lbl_Exit
        Exit Sub
        
    End Sub
    
    Private Sub UserForm_Initialize()
        Dim myArray() As String
        'Create list of teams
        myArray = Split("- Select -|Team 1|Team 2|Team 3", "|")
        'Use List method to populate ComboBox
        ComboBox1.List = myArray
        ComboBox1.ListIndex = 0
    lbl_Exit:
        Exit Sub
    End Sub
    
    Private Sub FillBM(strbmName As String, strValue As String)
        '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.Bookmarks.Add strbmName
            End If
        End With
    lbl_Exit:
        Set oRng = Nothing
        Exit Sub
    End Sub

  8. #8
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    You have to make the the listbox a multi-select list box.
    Greg

    Visit my website: http://gregmaxey.com

  9. #9
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Quote Originally Posted by gmaxey View Post
    You have to make the the listbox a multi-select list box.
    Doh!

    Apologies, this was my fault as I wasn't clear, but I was looking for the ListBox to provide a list of the names rather than as a sentence. The version you have kindly provided will obviously have its uses, although mine needs to populate into a table (two columns).

    Is there a way to "store" the names selected from one team so that the list can be added to by selecting names from other teams, without the ListBox starting over again?

    Thanks!

  10. #10
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    I've sorted out my 'Enter' button giving a compile error - sub or function not, but would really appreciate some help re my previous post.

    With my limited knowledge I'm guessing that each "group of people" selected from a "team" will need to be stored in either an array or variable? So that these can then somehow be concatenated to populate in the ListBox.

  11. #11
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    What exactly are you trying to do?
    Greg

    Visit my website: http://gregmaxey.com

  12. #12
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    There are three teams of people. Selections are required to be made predominantly from one team (duty team), then further people added from either of the other two teams (working as overtime). There should also be an option to add other people who do not appear in any of the three team lists too. These people could come from many other departments so it is completely impracticable to assign them to a fourth list of names.

    Once all the personal have been selected, they will be added to the word document at the allotted bookmark. This will need to be as a table that has two columns. The first column with the names of those previously selected, with the second column blank so that the inputter can add any notes against the name to identify say what hours they are working / in the office / working from home etc.

    My idea of using a ComboBox for the team selection was purely to try and minimise the amount of screen being taken up at any point, primarily for those using a laptop or tablet. It would be nice to be able to enter all the detail before pressing the 'Enter' button an committing the data to the form.

  13. #13
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Still looking for some help please, Greg. Thanks!

  14. #14
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    I have given you everything you need. If you want to post your form then I'll look again. I don't have time to create your form and write your code for you. Contact me offline if you want paid consulting services.

    Edit ~

    I was bored.

    Option Explicit
    Private Const Team_A As String = "Al,Tom,Mary"
    Private Const Team_B As String = "Joe,Tiny,Fat Boy"
    Private Const Team_C As String = "Marge,Alice,Tuco"
    
    Private Sub UserForm_Initialize()
      With lstTeams
        .MultiSelect = fmMultiSelectMulti
        .AddItem "Team A"
        .AddItem "Team B"
        .AddItem "Team C"
      End With
      lstTeamMembers.MultiSelect = fmMultiSelectMulti
      txtTeam.MultiLine = True
    End Sub
    
    Private Sub lstTeams_Change()
    Dim lngIndex As Long
    Dim lngSelected As Long
      lstTeamMembers.Clear
      For lngSelected = 0 To lstTeams.ListCount - 1
        If lstTeams.Selected(lngSelected) Then
          Select Case lngSelected
            Case 0
              For lngIndex = 0 To UBound(Split(Team_A, ","))
                lstTeamMembers.AddItem Split(Team_A, ",")(lngIndex)
              Next
            Case 1
              For lngIndex = 0 To UBound(Split(Team_B, ","))
                lstTeamMembers.AddItem Split(Team_B, ",")(lngIndex)
              Next
            Case 2
              For lngIndex = 0 To UBound(Split(Team_C, ","))
                lstTeamMembers.AddItem Split(Team_C, ",")(lngIndex)
              Next
          End Select
        End If
      Next lngSelected
    lbl_Exit:
      Exit Sub
    End Sub
    
    Private Sub lstTeamMembers_Change()
    Dim lngIndex As Long
    Dim lngSelected As Long
      txtTeam.Text = vbNullString
      For lngSelected = 0 To lstTeamMembers.ListCount - 1
        If lstTeamMembers.Selected(lngSelected) Then
          txtTeam.Text = txtTeam.Text & lstTeamMembers.List(lngSelected) & ","
        End If
      Next lngSelected
    lbl_Exit:
      Exit Sub
    End Sub
    
    Private Sub CommandButton1_Click()
    Dim arrTMs() As String
    Dim lngIndex As Long
      If Right(txtTeam.Text, 1) = "," Then txtTeam.Text = Left(txtTeam.Text, Len(txtTeam.Text) - 1)
      arrTMs = Split(txtTeam, ",")
      For lngIndex = 0 To UBound(arrTMs)
        MsgBox "Write " & arrTMs(lngIndex) & " to your document."
      Next
      Hide
    lbl_Exit:
      Exit Sub
    End Sub
    We are here to help you learn to write code. Not write if for you. That is what paid consultants are for. Remember:

    It is not from the benevolence of the butcher, the brewer, or the baker that we expect our dinner, but from their regard to their own interest.
    Last edited by gmaxey; 09-27-2020 at 08:38 AM.
    Greg

    Visit my website: http://gregmaxey.com

  15. #15
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Greg, your help is extremely appreciated. I'm determined to learn VBA as it has so many uses.

    What is the best resource to learn VBA from? I'd be really keen to develop my understanding.

    Meanwhile, whilst I was "tinkering" in the background with my own coding, you had got bored and provided more code! Thanks!

    Alas, it comes up with a "Compile error : Variable not defined" error here:-

    Private Sub UserForm_Initialize()
      With lstTeams

  16. #16
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    Seriously? Do you want something handed to you on a silver platter? Since I took the time to create a form to show you, I picked the control names.
    The form must have controls named:

    lstTeams
    lstTeamMembers
    txtTeam
    and
    CommandButton1
    Greg

    Visit my website: http://gregmaxey.com

  17. #17
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    It really is not my intention to get things handed out to me. As mentioned before, I really want to learn VBA and would appreciate some guidance as to where to start. There is a wealth of stuff on the Internet, but as with everything, there is also a lot of bad information.

    I am slowly picking up bits and pieces and have found this forum extremely helpful and interesting. Looking at many problems and their solutions I have tried to understand the processes that go into making good, clean and efficient coding. I'm also intrigued that in many instances there are more than a few ways of solving any particular problem.

    Thanks again!

  18. #18
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    Yep. Looking at and studying lots of code, rolling your sleeves up, sitting in piles of hair (if you have any) and bloody bits of scalp is probably the best way to learn. So you have no errors now? This issue is closed?
    Greg

    Visit my website: http://gregmaxey.com

  19. #19
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Ha ha , no hair left I'm afraid!

    Thanks for the advice.

    No error codes now. Just need to get these names into the left column of a two column table then job done.

  20. #20
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Okay, with a bit of tweaking here and there, utilizing sections of code already mentioned, I've come up with the following which works with no errors.

    This allows for names to be selected from any of the three teams, then compiled into a comma delimited list, that are entered at the Bookmark 'TeamMembers'.

    Forgetting the requirement for putting the names into a table.

    Is there a way of having an option of adding a note (i.e. overtime, working on a different site, starting one hour after official start) alongside any of the selected names if required?

    Option Explicit
    Dim oTeamMembers    As Range
    Dim otxtTeam        As Range
    
    Private Const Team_A As String = "Dave,Rob,Sarah,Dave,Rob,Sarah,Liz,Mike"
    Private Const Team_B As String = "Mike,June,Mary,John,Steve,Maria,Liz,Andy"
    Private Const Team_C As String = "Steve,John,Mary,Ivan,Dan,Lisa,Ian,Joan"
    
    Private Sub UserForm_Initialize()
        With Teams
            .MultiSelect = fmMultiSelectMulti
            .AddItem "Team A"
            .AddItem "Team B"
            .AddItem "Team C"
        End With
        TeamMembers.MultiSelect = fmMultiSelectMulti
        txtTeam.MultiLine = True
    End Sub
    
    Private Sub Teams_Change()
        Dim lngIndex    As Long
        Dim lngSelected As Long
        TeamMembers.Clear
        For lngSelected = 0 To Teams.ListCount - 1
            If Teams.Selected(lngSelected) Then
                Select Case lngSelected
                    Case 0
                        For lngIndex = 0 To UBound(Split(Team_A, ","))
                            TeamMembers.AddItem Split(Team_A, ",")(lngIndex)
                        Next
                    Case 1
                        For lngIndex = 0 To UBound(Split(Team_B, ","))
                            TeamMembers.AddItem Split(Team_B, ",")(lngIndex)
                        Next
                    Case 2
                        For lngIndex = 0 To UBound(Split(Team_C, ","))
                            TeamMembers.AddItem Split(Team_C, ",")(lngIndex)
                        Next
                End Select
            End If
        Next lngSelected
    lbl_Exit:
        Exit Sub
    End Sub
    
    Private Sub TeamMembers_Change()
        Dim lngIndex    As Long, lngCount As Long
        Dim arrTMs()    As String
        lngCount = 0
        For lngIndex = 0 To TeamMembers.ListCount - 1
            If TeamMembers.Selected(lngIndex) Then
                ReDim Preserve arrTMs(lngCount)
                lngCount = lngCount + 1
                arrTMs(UBound(arrTMs)) = TeamMembers.List(lngIndex)
            End If
        Next lngIndex
        If IsArray(arrTMs) Then txtTeam = fcnArrayToCommaAndDelimtedList(arrTMs)
    End Sub
    
    '**** Create a comma/and delimited list
    Public Function fcnArrayToCommaAndDelimtedList(varIn As Variant, Optional bOxford As Boolean = False) As String
        Dim strTemp     As String
        Dim lngIndex    As Long
        On Error GoTo lbl_Exit
        Select Case UBound(varIn)
            Case 0: fcnArrayToCommaAndDelimtedList = varIn(0)
            Case 1: fcnArrayToCommaAndDelimtedList = varIn(0) & " and " & varIn(1)
            Case Else
                fcnArrayToCommaAndDelimtedList = varIn(0)
                lngIndex = 1
                Do While lngIndex < UBound(varIn)
                    fcnArrayToCommaAndDelimtedList = fcnArrayToCommaAndDelimtedList & ", " & varIn(lngIndex)
                    lngIndex = lngIndex + 1
                Loop
                If bOxford Then
                    fcnArrayToCommaAndDelimtedList = fcnArrayToCommaAndDelimtedList & ", and " & varIn(lngIndex)
                Else
                    fcnArrayToCommaAndDelimtedList = fcnArrayToCommaAndDelimtedList & " and " & varIn(lngIndex)
                End If
        End Select
    lbl_Exit:
        Exit Function
    End Function
    
    'Enter button
    Private Sub EnterBut_Click()
    
    'Check required fields are filled out
        
        If txtTeam.Text = "" Then
            MsgBox "Provide list of team members", vbCritical, "Triage Hub"
            txtTeam.SetFocus
            Exit Sub
        End If
        
        'use FillBM function to write bookmarks
        FillBM "TeamMembers", txtTeam.Text
        
        Set oTeamMembers = Nothing
        Set otxtTeam = Nothing
        Unload Me
        
        Exit Sub
    End Sub
    
    Private Sub FillBM(strbmName As String, strValue As String)
        '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.Bookmarks.Add strbmName
            End If
        End With
    lbl_Exit:
        Set oRng = Nothing
        Exit Sub
    End Sub

Posting Permissions

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