selecting and naming multiple workbooks from listbox

helpexcel

Well-known Member
Joined
Oct 21, 2009
Messages
656
Hi - i'm using the code below to show open workbooks which the user can then select one. How do I update the code to allow the user to select multiple workbooks and how do I name them?

Code in a Module
Code:
Dim WB As Workbook
 For Each WB In Workbooks
     UserForm5.ListBox1.AddItem WB.Name
   Next WB
UserForm1.Show

Code in Form
Code:
Private Sub ListBox1_AfterUpdate()


listchoice = ListBox1.Text


End Sub
 
You are confusing me :confused:

What is in ListBox1 ? (I think it a list of all open workbooks from this bit of code in post#1)
Code:
 For Each WB In Workbooks
     UserForm5.ListBox1.AddItem WB.Name
  Next WB

What is in ListBox2 ?
How is it updated ?
 
Last edited:
Upvote 0

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
ListBox1 was the code I already have that i'm trying to modify. Listbox2 works the same way. it's populated by the names of all the open workbooks, but i want to be able to select multiple workbooks, instead of just one. I then want to copy ranges (i.e. A11&LR) from sheet1 on the selected workbooks on paste it to A11 on sheet1 in ws3.
 
Upvote 0
I think I want to say N1=listbox1.value and then use that to define ws1 as workbooks(N1).sheet1

Earlier code shows how to derive strings N1 and N2

To set the 2 worksheets, try ...
Code:
Dim wb1 As WorkBook, wb2 As WorkBook
Dim ws1 As WorkSheet, ws2 As WorkSheet
Set wb1= Workbooks(N1 & ".xlsx")
Set wb2= Workbooks(N2 & ".xlsx")
Set ws1= wb1.Sheets(1)
Set ws2= wb2.Sheets(1)
 
Upvote 0
ListBox1 was the code I already have that i'm trying to modify. Listbox2 works the same way. it's populated by the names of all the open workbooks, but i want to be able to select multiple workbooks, instead of just one.

Do you want to select 2 workbooks (as per OP) or any number of workbooks ?

I then want to copy ranges (i.e. A11&LR) from sheet1 on the selected workbooks on paste it to A11 on sheet1 in ws3

copy ranges (i.e. A11&LR)
- is this only column A or whole rows ?

paste it to A11 on sheet1 in ws3
- continually pasting to A11 will keep overwriting the data (ws2 data will overwrite ws1 data etc)
- do you mean paste to the next available cell in column A (below A11)
 
Upvote 0
here is the whole code that works great. thanks! Would I just update the c=2 to c=3 and and N3 if i want to allow 3 selections?

Code:
Public N1 As String, N2 As String


Private Sub ListBox3_Change()
'This limits selection to 2 names
    Dim x As Long, c As Long
    With ListBox3
        For x = 0 To .ListCount - 1
            If .Selected(x) = True Then
                c = c + 1
                If c = 2 Then Call ListBox3_AfterUpdate
            End If
        Next
    End With
End Sub


Private Sub ListBox3_AfterUpdate()
'This returns N1 and N2 = selected items
    Dim x As Long
    With ListBox3
        For x = 0 To .ListCount - 1
            If .Selected(x) = True Then
                If N2 <> "" Then Exit For
                If N1 = "" Then N1 = .List(x) Else N2 = .List(x)
                .Selected(x) = False
            End If
        Next
    End With
    
End Sub


Private Sub CommandButton1_Click()
Call Copy
Unload Me
End Sub


Private Sub CommandButton2_Click()
Unload Me
End
End Sub


Sub Copy()
Application.ScreenUpdating = False
     
Dim wb1, wb2 As Workbook
Dim ws1, ws2, ws3, wsSP As Worksheet
Dim LR, LR2 As Long
Dim Cl As Range
sName = "Sheet1"
   
   Set wb1 = Workbooks(N1)
   Set wb2 = Workbooks(N2)
          
    Set wsSP = Sheet1 
    Set ws1 = Sheet2
     
    Set ws2 = wb1.Sheets(sName)
    Set ws3 = wb2.Sheets(sName)
 
    With ws2
        LR = .Cells(.Rows.Count, "C").End(xlUp).Row - 2
        .Range("C11:C" & LR).Copy
        ws1.Range("A11").PasteSpecial xlPasteValues
    End With
    
    LR2 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    
    With ws3
        LR = .Cells(.Rows.Count, "C").End(xlUp).Row - 2
        .Range("C11:C" & LR).Copy
        ws1.Range("A" & LR2).PasteSpecial xlPasteValues
    End With

Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
The way it is written, the code will get increasingly messy as the the number of workbooks increases
- perhpas a different approach is better
- same code but done differently
- Listbox_AfterUpdate not required
- Listbox_Change not required
- although you do need to use something to trigger the Copy (button perhaps)
- ensure Copy is in the userform code

It would be simpler to do everything in Copy ...
- here is how to get each worksheet
- there is now only ONE variable for the sheets to be copied

Code:
Private Sub Copy()
[COLOR=#006400]EXTRACT ONLY 
[/COLOR]
    Dim x As Long, wb As Workbook, ws As Worksheet

    [COLOR=#ff0000]include code here to set the main worksheet etc[/COLOR][COLOR=#006400]
[/COLOR]
    With ListBox3
        For x = 0 To .ListCount - 1
            If .Selected(x) = True Then
                Set wb = WorkBooks( .List(x) & "xlsx")
                Set ws = wb.Sheets(1)
                [COLOR=#ff0000]Put modified copying code here to copy each selected sheet in sequence
[/COLOR]            End If
        Next x
    End With   
End Sub
Code:
The modified code will be similar to this
[CODE]    With [COLOR=#ff0000]ws[/COLOR]
        LR = .Cells(.Rows.Count, "C").End(xlUp).Row - 2
        .Range("C11:C" & LR).Copy
        ws1.Range("A11").PasteSpecial xlPasteValues   [COLOR=#006400][I]??? MODIFY to suit every occurrence (only A11 for the first sheet)[/I][/COLOR]
    End With

Hopefully that is clear enough
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,585
Messages
6,120,394
Members
448,957
Latest member
Hat4Life

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