Multiselect ListBox Problem

LizCorbert

New Member
Joined
Oct 29, 2014
Messages
25
Hi All,

Can someone please assist me. I have created a multi select listbox 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 returned generates 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
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Sorry, I am still learning how to correctly post a question. Here is my original post edited -

Hi All,

Can someone please assist me. I have created a multi select listbox in <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">VBA</acronym> 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 returned generates a new workbook containing Client_Profile and SubmissionProperty, and another workbook containing Client_Profile and SubmissionLiability. Please review the code for me:

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


 
Upvote 0

Forum statistics

Threads
1,215,035
Messages
6,122,791
Members
449,095
Latest member
m_smith_solihull

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top