Multi-Select List Box Issue

Lizzie

New member
Joined
Feb 5, 2016
Messages
2
Reaction score
0
Points
0
Location
Chicago
Hi All,


I would appreciate any assistance provided to me for the following issue:


The workbook that is associated with the below code contains a "Create Documents" worksheet that encompasses three buttons. I am presently working within the "Submission Document" button on the first two listbox items named "Property" and "General Liability". If the user selects any of these items a new workbook is to be produced that defines an array specific to the listbox item selection. If the user selects "Property" a new workbook is generated that contains a "Client_Profile" worksheet and a "SubmissionProperty" worksheet as specified in the array. If the user selects "General Liability" a new workbook is generated that contains a "Client_Profile" worksheet and a "SubmsissionLiability" worksheet also specified by the array. The code performs up to this point.


However, when the user selects "Property" and "General Liability", the requirement for one new workbook that contains a "Client_Profile" worksheet, a "SubmissionProperty" worksheet, and a "SubmissionLiability" worksheet, fails. What is produced are two workbooks. One workbook that contains a "Client_Profile" worksheet and a "SubmissionProperty" worksheet. The other workbook contains a "Client_Profile" worksheet and a "SubmsissionLiability" worksheet. The code resides in the SubmissionSelector user form.

Thanks for any and all assistance!

Code:
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 j As Long
Dim cnt As Long
Dim arrSheets(0) As String
arrSheets(0) = "Client_Profile"
cnt = 1

For j = 0 To Me.Submissionlist.ListCount - 1
    If Me.Submissionlist.Selected(j) Then
    arrSheets(cnt) = Me.Submissionlist.List(j)
    cnt = cnt + 1
Sheets("SubmissionProperty").Visible = False
ThisWorkbook.Worksheets(Array(arrSheets(0), "SubmissionProperty")).Copy
Sheets("SubmissionProperty").Visible = True
Worksheets(arrSheets(0)).Move Before:=Worksheets(1)
Worksheets(arrSheets(0)).Activate
            If selCount = -1 Then
            Me.Submissionlist.Selected(j) = False
            Me.Submissionlist.Clear
                End If
                End If
                Exit For
                Next
For j = 1 To Me.Submissionlist.ListCount - 1
        If Me.Submissionlist.Selected(j) Then
    arrSheets(cnt) = Me.Submissionlist.List(j)
    cnt = cnt + 1
Sheets("SubmissionLiabilty").Visible = False
ThisWorkbook.Worksheets(Array(arrSheets(0), "SubmissionLiabilty")).Copy
Sheets("SubmissionLiabilty").Visible = True
Worksheets(arrSheets(0)).Move Before:=Worksheets(1)
Worksheets(arrSheets(0)).Activate
            If selCount = -1 Then
            Me.Submissionlist.Selected(j) = False
            Me.Submissionlist.Clear
                End If
                End If
                Exit For
                Next
For j = 0 And j = 1 To Me.Submissionlist.ListCount - 1
     If Me.Submissionlist.Selected(j) = True Then
    arrSheets(cnt) = Me.Submissionlist.List(j)
    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(arrSheets(0)).Move Before:=Worksheets(1)
Worksheets(arrSheets(0)).Activate
            If selCount = -1 Then
            Me.Submissionlist.Selected(j) = False
            Me.Submissionlist.Clear
                End If
                End If
                Exit For
                Next
                
If Me.Submissionlist.Value Then Unload Me
Application.ScreenUpdating = True

End Sub
 
Last edited:
cross posted same or very similar without links:
http://www.vbaexpress.com/forum/showthread.php?55037-VBA-Multi-Select-ListBox-Issues
http://www.mrexcel.com/forum/excel-questions/918604-multiselect-listbox-problem.html
http://www.mrexcel.com/forum/excel-...c-applications-mulitselect-listbox-items.html

Lizzie/LizCorbert, for your information, you should always provide links to your cross posts. All forums have very similar rules and MrExcel is less forgiving in this regard.
If you have cross posted at other places, please add links to them too.
Why? Have a read of http://www.excelguru.ca/content.php?184
 
Sorry. I just read the rules after this complaint. Irresponsible on my part. Will not occur again. My apologies to all.

Lizzie
 
Back
Top