none
Excel VBA Multiselect ListBox Problem RRS feed

  • Question

  • Can someone please assist me. I have created a code in VBA that will create new workbooks based on the user selection of ListBox items. I have written the following code which works great for single selections. However if index item 0 and 1 are selected two new workbooks are produced. I need one workbook to be produced based off of the array provided. Instead of a workbook that produces three sheets (Client_Profile, SubmissionProperty, and SubmissionLiability), the result returns a new workbook containing Client_Profile and SubmissionProperty, and another workbook containing Client_Profile and SubmissionLiability. Please review the code for me:

    Dim ThisWorkbook As Workbook
    Set ThisWorkbook = ActiveWorkbook
    
    Dim selCount As Long
    selCount = -1
    
    Dim R As Long
    R = 0
    Dim S As Long
    S = 1
    Dim I As Long
    I = 0 & 1
    
    For R = R To Me.Submissionlist.ListCount - 1
    If Me.Submissionlist.Selected(R) Then
    Sheets("SubmissionProperty").Visible = False
    ThisWorkbook.Worksheets(Array("Client_Profile", "SubmissionProperty")).Copy
    Sheets("SubmissionProperty").Visible = True
    Worksheets("SubmissionLiability").Visible = False
    Worksheets("Client_Profile").Move Before:=Worksheets(1)
    Worksheets("Client_Profile").Activate
    Range("A1").Select
    End If
    If selCount = -1 Then
    Me.Submissionlist.Selected(R) = False
    Me.Submissionlist.Clear
    End If
    Exit For
    Next
    
    For S = S To Me.Submissionlist.ListCount - 1
    If Me.Submissionlist.Selected(S) Then
    Sheets("SubmissionLiabilty").Visible = False
    ThisWorkbook.Worksheets(Array("Client_Profile", "SubmissionLiabilty")).Copy
    Sheets("SubmissionLiabilty").Visible = True
    Worksheets("Client_Profile").Move Before:=Worksheets(1)
    Worksheets("Client_Profile").Activate
    End If
    If selCount = -1 Then
    Me.Submissionlist.Selected(S) = False
    Me.Submissionlist.Clear
    End If
    Exit For
    Next
    
    For I = R & S To Me.Submissionlist.ListCount - 1
    If Me.Submissionlist.Selected(I) = True Then
    Sheets("SubmissionProperty").Visible = False
    Sheets("SubmissionLiabilty").Visible = False
    ThisWorkbook.Worksheets(Array("Client_Profile", "SubmissionProperty", "SubmissionLiabilty")).Copy
    Sheets("SubmissionProperty").Visible = True
    Sheets("SubmissionLiabilty").Visible = True
    Worksheets("Client_Profile").Move Before:=Worksheets(1)
    Worksheets("Client_Profile").Activate
    End If
    If selCount = -1 Then
    Me.Submissionlist.Selected(I) = False
    Me.Submissionlist.Clear
    End If
    Exit For
    Next
    
    If Me.Submissionlist.Value Then Unload Me
    Application.ScreenUpdating = True
    
    End Sub

    LizzieC

    Wednesday, February 3, 2016 8:27 PM

All replies

  • Hi LizzieC,

    With first glance at your code....
    1) please show the full procedure.
        "End Sub" exists, but "Sub" cannot be found.
    2) there're several "Exit For" in "For" loop.
        Do they have any meanings? 
    3) final "If" clause before "End Sub" has no "End If".
    4) I'd be happy, if you will provide your Excel file via cloud storage, such as OneDrive, Dropbox, etc.

    Regards.
    Thursday, February 4, 2016 2:15 AM
  • Hi, LizzieC

    According to your description, since there is less information, I am not able to reproduce your issue.I find you use ListBox.ListCount property in your sample codes, ListBox.ListCount property returns the number of entries in a list box, so I suggest that you could refer to below code to get multi List Box selections:

    For I = 0 To ListBox1.ListCount - 1
         If ListBox1.Selected(I) = True Then
             Debug.Print ListBox1.List(I)
         End If
    Next I

    Thursday, February 4, 2016 6:25 AM
  • Please find the full procedure:

    Private Sub CMDSubSelector_Click()
    SubmissionSelector.Hide
    
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationAutomatic
    
     Sheets("SubmissionProperty").Visible = True
        Worksheets("Property").Activate
        Range("D7:D9").Select
        Selection.Copy
        Worksheets("SubmissionProperty").Activate
        Range("C5:C7").Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    
        Worksheets("Property").Activate
        Range("D11:D97").Select
        Selection.Copy
        Worksheets("SubmissionProperty").Activate
        Range("C9").Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Range("A1").Select
    Sheets("SubmissionProperty").Visible = False
    
        Sheets("SubmissionLiability").Visible = True
        Worksheets("General_Liability").Activate
        Range("D7:D9").Select
        Selection.Copy
        Worksheets("SubmissionLiabilty").Activate
        Range("C5:C7").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    
        Worksheets("General_Liability").Activate
        Range("D11:D97").Select
        Selection.Copy
        Worksheets("SubmissionLiabilty").Activate
        Range("C9").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Range("A1").Select
        Sheets("SubmissionLiability").Visible = False
        
    Dim ThisWorkbook As Workbook
    Set ThisWorkbook = ActiveWorkbook
    
    Dim selCount As Long
    selCount = -1
    
    Dim R As Long
    R = 0
    Dim S As Long
    S = 1
    Dim I As Long
    I = 0 & 1
    
    Dim cnt As Long
    Dim arrSheets(0) As String
    arrSheets(0) = "Client_Profile"
    cnt = 1
    
    For R = 0 To Me.Submissionlist.ListCount - 1
        If Me.Submissionlist.Selected(R) Then
        Debug.Print Submissionlist.List(R)
         arrSheets(cnt) = Me.Submissionlist.List(R)
         cnt = cnt + 1
    Sheets("SubmissionProperty").Visible = False
    ThisWorkbook.Worksheets(Array(arrSheets(0), "SubmissionProperty")).Copy
    Sheets("SubmissionProperty").Visible = True
    Worksheets("SubmissionLiability").Visible = False
    Worksheets(arrSheets(0)).Move Before:=Worksheets(1)
    Worksheets(arrSheets(0)).Activate
    Range("A1").Select
                    End If
    If selCount = -1 Then
                Me.Submissionlist.Selected(R) = False
                Me.Submissionlist.Clear
                    End If
                    Exit For
                    Next
    
    For S = 1 To Me.Submissionlist.ListCount - 1
            If Me.Submissionlist.Selected(S) Then
            Debug.Print Submissionlist.List(S)
         arrSheets(cnt) = Me.Submissionlist.List(S)
         cnt = cnt + 1
    Sheets("SubmissionLiabilty").Visible = False
    ThisWorkbook.Worksheets(Array(arrSheets(0), "SubmissionLiabilty")).Copy
    Sheets("SubmissionLiabilty").Visible = True
    Worksheets("Client_Profile").Move Before:=Worksheets(1)
    Worksheets("Client_Profile").Activate
                    End If
        If selCount = -1 Then
                Me.Submissionlist.Selected(S) = False
                Me.Submissionlist.Clear
                    End If
                    Exit For
                    Next
              
    For I = 0 & 1 To Me.Submissionlist.ListCount - 1
         If Me.Submissionlist.Selected(I) = True Then
         Debug.Print Submissionlist.List(I)
         arrSheets(cnt) = Me.Submissionlist.List(I)
         cnt = cnt + 1
    Sheets("SubmissionProperty").Visible = False
    Sheets("SubmissionLiabilty").Visible = False
    ThisWorkbook.Worksheets(Array(arrSheets(0), "SubmissionProperty", "SubmissionLiabilty")).Copy
    Sheets("SubmissionProperty").Visible = True
    Sheets("SubmissionLiabilty").Visible = True
    Worksheets("Client_Profile").Move Before:=Worksheets(1)
    Worksheets("Client_Profile").Activate
                    End If
        If selCount = -1 Then
                Me.Submissionlist.Selected(I) = False
                Me.Submissionlist.Clear
                    End If
                    Exit For
                    Next
                    
                                                     
    If Me.Submissionlist.Value Then Unload Me
    Application.ScreenUpdating = True
    
    End Sub
    Private Sub UserForm_Click()
    SubmissionSelector.Show
    End Sub
    Sub BoundDocument()
              
         Application.ScreenUpdating = False
         
        Sheets("BoundDetails").Visible = False
        Sheets("BoundSummary").Visible = False
        Sheets("BoundProperty").Visible = False
        Sheets("BoundLiability").Visible = False
            
    Dim wbNew As Workbook
    Set wbNew = ActiveWorkbook
                   
    ThisWorkbook.Worksheets(Array("Client_Profile", "BoundSummary", "BoundDetails", "BoundProperty", "BoundLiability")).Copy
     
        Sheets("BoundDetails").Visible = True
        Sheets("BoundSummary").Visible = True
        Sheets("BoundProperty").Visible = True
        Sheets("BoundLiability").Visible = True
        
    Worksheets("Client_Profile").Move Before:=Worksheets(1)
    Worksheets("BoundSummary").Move After:=Worksheets(1)
    Worksheets("Client_Profile").Activate
        
    Application.ScreenUpdating = True
    
    Exit Sub
    
    Unload Me
    
    Application.ScreenUpdating = True
    
    
    End Sub
    


    LizzieC

    Thursday, February 4, 2016 7:22 AM
  • Thanks for your response. Please review my full procedure that I posted. I did update the code with your suggestion but it still does not perform the multiselect functions properly. I am certain that I got lost in the coding process.

    Thanks,

    Lizzie


    LizzieC

    Thursday, February 4, 2016 7:24 AM
  • Thanks for responding. I posted the full procedure. I am lost right now, and the more I try to figure this out the more lost I get.

    Thanks,

    Lizzie


    LizzieC

    Thursday, February 4, 2016 7:26 AM
  • Hi LizzieC,

    I mentioned before:
      2) there're several "Exit For" in "For" loop. 
          Do they have any meanings? 

    Have you thought about it?
    I think "Exit For" is to be deleted, or to be placed at other line.

    Regards.

    P.S.
      Have you compiled your code?
      I'm afraid syntax error(s) exist in your code.
    • Edited by Ashidacchi Thursday, February 4, 2016 7:36 AM
    Thursday, February 4, 2016 7:34 AM
  • I believed that the numerous Exit For where required for the code.Yes, I compiled the code and I do not receive andy syntax error(s). It actually performs except for the multi select function that does not produce one workbook based on the array (Client_Profile, SubmissionProperty, and SubmissionLiability).


    LizzieC



    • Edited by LizzieC Thursday, February 4, 2016 7:42 AM
    Thursday, February 4, 2016 7:40 AM
  • Please share your Excel file via cloud storage, such as OneDrive, Dropbox, etc.
    Thursday, February 4, 2016 7:47 AM
  • Please advise me how I would do that on this forum. Thanks so much.

    LizzieC

    Thursday, February 4, 2016 7:48 AM
  • <g class="gr_ gr_22 gr-alert gr_spell undefined ContextualSpelling ins-del multiReplace" data-gr-id="22" id="22">Ashidacchi</g>,

    I copied over a piece of another code by mistake to you. I apologize. This is the full procedure. Again, my apologies!

    Private Sub CMDSubSelector_Click()
    SubmissionSelector.Hide
    
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationAutomatic
    
     Sheets("SubmissionProperty").Visible = True
        Worksheets("Property").Activate
        Range("D7:D9").Select
        Selection.Copy
        Worksheets("SubmissionProperty").Activate
        Range("C5:C7").Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    
        Worksheets("Property").Activate
        Range("D11:D97").Select
        Selection.Copy
        Worksheets("SubmissionProperty").Activate
        Range("C9").Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Range("A1").Select
    Sheets("SubmissionProperty").Visible = False
    
        Sheets("SubmissionLiability").Visible = True
        Worksheets("General_Liability").Activate
        Range("D7:D9").Select
        Selection.Copy
        Worksheets("SubmissionLiabilty").Activate
        Range("C5:C7").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    
        Worksheets("General_Liability").Activate
        Range("D11:D97").Select
        Selection.Copy
        Worksheets("SubmissionLiabilty").Activate
        Range("C9").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Range("A1").Select
        Sheets("SubmissionLiability").Visible = False
        
    Dim ThisWorkbook As Workbook
    Set ThisWorkbook = ActiveWorkbook
    
    Dim selCount As Long
    selCount = -1
    
    Dim R As Long
    R = 0
    Dim S As Long
    S = 1
    Dim I As Long
    I = 0 & 1
    
    Dim cnt As Long
    Dim arrSheets(0) As String
    arrSheets(0) = "Client_Profile"
    cnt = 1
    
    For R = 0 To Me.Submissionlist.ListCount - 1
        If Me.Submissionlist.Selected(R) Then
        Debug.Print Submissionlist.List(R)
         arrSheets(cnt) = Me.Submissionlist.List(R)
         cnt = cnt + 1
    Sheets("SubmissionProperty").Visible = False
    ThisWorkbook.Worksheets(Array(arrSheets(0), "SubmissionProperty")).Copy
    Sheets("SubmissionProperty").Visible = True
    Worksheets("SubmissionLiability").Visible = False
    Worksheets(arrSheets(0)).Move Before:=Worksheets(1)
    Worksheets(arrSheets(0)).Activate
    Range("A1").Select
                    End If
    If selCount = -1 Then
                Me.Submissionlist.Selected(R) = False
                Me.Submissionlist.Clear
                    End If
                    Exit For
                    Next
    
    For S = 1 To Me.Submissionlist.ListCount - 1
            If Me.Submissionlist.Selected(S) Then
            Debug.Print Submissionlist.List(S)
         arrSheets(cnt) = Me.Submissionlist.List(S)
         cnt = cnt + 1
    Sheets("SubmissionLiabilty").Visible = False
    ThisWorkbook.Worksheets(Array(arrSheets(0), "SubmissionLiabilty")).Copy
    Sheets("SubmissionLiabilty").Visible = True
    Worksheets("Client_Profile").Move Before:=Worksheets(1)
    Worksheets("Client_Profile").Activate
                    End If
        If selCount = -1 Then
                Me.Submissionlist.Selected(S) = False
                Me.Submissionlist.Clear
                    End If
                    Exit For
                    Next
              
    For I = 0 & 1 To Me.Submissionlist.ListCount - 1
         If Me.Submissionlist.Selected(I) = True Then
         Debug.Print Submissionlist.List(I)
         arrSheets(cnt) = Me.Submissionlist.List(I)
         cnt = cnt + 1
    Sheets("SubmissionProperty").Visible = False
    Sheets("SubmissionLiabilty").Visible = False
    ThisWorkbook.Worksheets(Array(arrSheets(0), "SubmissionProperty", "SubmissionLiabilty")).Copy
    Sheets("SubmissionProperty").Visible = True
    Sheets("SubmissionLiabilty").Visible = True
    Worksheets("Client_Profile").Move Before:=Worksheets(1)
    Worksheets("Client_Profile").Activate
                    End If
        If selCount = -1 Then
                Me.Submissionlist.Selected(I) = False
                Me.Submissionlist.Clear
                    End If
                    Exit For
                    Next
                    
                                                     
    If Me.Submissionlist.Value Then Unload Me
    Application.ScreenUpdating = True
    
    End Sub


    LizzieC


    • Edited by LizzieC Thursday, February 4, 2016 8:02 AM
    Thursday, February 4, 2016 8:01 AM
  • 1) Please indent in your code. It's hard to read.
    2) Make your code simpler, less lines. for example
        Worksheets("Property").Activate
        Range("D7:D9").Select
        Selection.Copy
        Worksheets("SubmissionProperty").Activate
        Range("C5:C7").Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Worksheets("Property").Range("D7:D9").Copy
        Worksheets("SubmissionProperty").Range("C5").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    







        
    Thursday, February 4, 2016 8:10 AM
  • I'm afraid that in the below "For" loop, its contents will be executed only once, because "Exit For" exists.
    Is it OK?
    For S = 1 To Me.Submissionlist.ListCount - 1
        If Me.Submissionlist.Selected(S) Then
            Debug.Print Submissionlist.List(S)
            arrSheets(cnt) = Me.Submissionlist.List(S)
            cnt = cnt + 1
            Sheets("SubmissionLiabilty").Visible = False
            ThisWorkbook.Worksheets(Array(arrSheets(0), "SubmissionLiabilty")).Copy
            Sheets("SubmissionLiabilty").Visible = True
            Worksheets("Client_Profile").Move Before:=Worksheets(1)
            Worksheets("Client_Profile").Activate
        End If
        If selCount = -1 Then
            Me.Submissionlist.Selected(S) = False
            Me.Submissionlist.Clear
        End If
        Exit For
    Next
    Thursday, February 4, 2016 8:18 AM
  • No, that is not okay. I believe I got confused with the looping. I really appreciate all the help you are giving me. I am reposting the code now. I hope this reads better.

    Private Sub CMDSubSelector_Click()
    SubmissionSelector.Hide
    
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationAutomatic
    
        Sheets("SubmissionProperty").Visible = True
        Worksheets("Property").Activate
        Range("D7:D9").Select
        Selection.Copy
        Worksheets("SubmissionProperty").Activate
        Range("C5:C7").Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    
        Worksheets("Property").Activate
        Range("D11:D97").Select
        Selection.Copy
        Worksheets("SubmissionProperty").Activate
        Range("C9").Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Range("A1").Select
        Sheets("SubmissionProperty").Visible = False
    
        Sheets("SubmissionLiability").Visible = True
        Worksheets("General_Liability").Activate
        Range("D7:D9").Select
        Selection.Copy
        Worksheets("SubmissionLiabilty").Activate
        Range("C5:C7").Select
        Selection.PasteSpecial Paste:=xlPasteValues,          Operation:=xlNone, SkipBlanks:=False,   Transpose:=False
        Application.CutCopyMode = False
    
        Worksheets("General_Liability").Activate
        Range("D11:D97").Select
        Selection.Copy
        Worksheets("SubmissionLiabilty").Activate
        Range("C9").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Range("A1").Select
        Sheets("SubmissionLiability").Visible = False
        
    Dim ThisWorkbook As Workbook
    Set ThisWorkbook = ActiveWorkbook
    Dim selCount As Long
    selCount = -1
    
    Dim R As Long
    R = 0
    Dim S As Long
    S = 1
    Dim I As Long
    I = 0 & 1
    
    Dim cnt As Long
    Dim arrSheets(0) As String
    arrSheets(0) = "Client_Profile"
    cnt = 1
    
    For R = 0 To Me.Submissionlist.ListCount – 1
    If Me.Submissionlist.Selected(R) Then
    Debug.Print Submissionlist.List(R)
    arrSheets(cnt) = Me.Submissionlist.List(R)
    cnt = cnt + 1
    Sheets("SubmissionProperty").Visible = False
    ThisWorkbook.Worksheets(Array(arrSheets(0), "SubmissionProperty")).Copy
    Sheets("SubmissionProperty").Visible = True
    Worksheets("SubmissionLiability").Visible = False
    Worksheets(arrSheets(0)).Move Before:=Worksheets(1)
    Worksheets(arrSheets(0)).Activate
    Range("A1").Select
                    End If
    If selCount = -1 Then
                Me.Submissionlist.Selected(R) = False
                Me.Submissionlist.Clear
                    End If
                    Exit For
                    Next
    
    For S = 1 To Me.Submissionlist.ListCount - 1 
    If Me.Submissionlist.Selected(S) Then
    Debug.Print Submissionlist.List(S)
    arrSheets(cnt) = Me.Submissionlist.List(S)
    cnt = cnt + 1
    Sheets("SubmissionLiabilty").Visible = False
    ThisWorkbook.Worksheets(Array(arrSheets(0), "SubmissionLiabilty")).Copy
    Sheets("SubmissionLiabilty").Visible = True
    Worksheets("Client_Profile").Move Before:=Worksheets(1)
    Worksheets("Client_Profile").Activate
                    End If
        If selCount = -1 Then
                Me.Submissionlist.Selected(S) = False
                Me.Submissionlist.Clear
                    End If
                    Exit For
                    Next
              
    For I = 0 & 1 To Me.Submissionlist.ListCount - 1
    If Me.Submissionlist.Selected(I) = True Then
     Debug.Print Submissionlist.List(I)
     arrSheets(cnt) = Me.Submissionlist.List(I)
    cnt = cnt + 1
    Sheets("SubmissionProperty").Visible = False
    Sheets("SubmissionLiabilty").Visible = False
    ThisWorkbook.Worksheets(Array(arrSheets(0), "SubmissionProperty", "SubmissionLiabilty")).Copy
    Sheets("SubmissionProperty").Visible = True
    Sheets("SubmissionLiabilty").Visible = True
    Worksheets("Client_Profile").Move Before:=Worksheets(1)
    Worksheets("Client_Profile").Activate
                    End If
        If selCount = -1 Then
                Me.Submissionlist.Selected(I) = False
                Me.Submissionlist.Clear
                    End If
                    Exit For
                    Next             
                                                     
    If Me.Submissionlist.Value Then Unload Me
    Application.ScreenUpdating = True
    
    End Sub
    


    LizzieC

    Thursday, February 4, 2016 8:24 AM
  • "End If" is missing. 
    If Me.Submissionlist.Value Then Unload Me
    Application.ScreenUpdating = True
    
    End Sub
    You mentioned "I compiled the code and I do not receive andy syntax error(s)."
    I'm afraid there must be syntax error(s).



    Thursday, February 4, 2016 8:27 AM
  • I will remove the "Exit For" statements except for the last one and insert an end if at the end and see what happens. I really do appreciate your help. I have been working on this section for days on end for a resolution.

    LizzieC

    Thursday, February 4, 2016 8:30 AM
  • I made the suggestions and the single selections perform effectively using the array. The multi-select generate two workbooks, one with just the Client_Profile worksheet and another one with the Client_profile and SubmissionProperty worksheet.

    LizzieC




    • Edited by LizzieC Thursday, February 4, 2016 8:37 AM
    Thursday, February 4, 2016 8:34 AM
  • I will look again for syntax errors, however it does compile. 

    LizzieC

    Thursday, February 4, 2016 8:38 AM