VBA Multi Select ListBox Issues

[LizCorbert]

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 AsLong
selCount=-1


Dim R AsLong
R=0
Dim S AsLong
S=1
Dim I AsLong
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 =-1Then
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)=TrueThen
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 =-1Then
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