Populating List box with data from other excel file

1) I have two excel files

a. ListBox.xls (my code is in this file)

b. Data ListbBox.xls



2) The data in list box in listbox.xls should be populated from the data available in
Data ListBox.xls.

3) User selects multiple data in the list box, what ever the user selects, should be copied to List Box.xls file with the types such as Floor, Roof & Wall presented together respectively.

4) The primary key is Data in A column (part1, part2, part3 etc) available in data listbox.xls. But when loading the list box, it should have multiple columns in the list box showing DATA-TYPE-LENGTH-WIDTH



Regards,

Prakash

Hi surya,

This could be refined, but it should get you started...

First off, this goes into module1 in your List Box book:

Code:

---

Public Sub CallDialog()
'//we're assuming here that both books are on the desktop
Application.Workbooks.Open "c:/Windows/Desktop/Data ListBox.xls"
ThisWorkbook.Activate
UserForm1.Show
End Sub

---

And this goes into your Userform Module[vba]Private Sub UserForm_Activate()

Code:

---

Dim MyList(50, 4), M%, N%
With ListBox1
.ColumnCount = 4
.ColumnWidths = "33pt;33pt;33pt;33pt"
.Width = 160
.Height = 120
.BoundColumn = 1
End With
For N = 1 To 50
M = N - 1
Application.ScreenUpdating = False
Workbooks("Data ListBox").Activate
With ActiveWorkbook.Worksheets("Sheet1")
MyList(M, 0) = Range("A" & N)
MyList(M, 1) = Range("B" & N)
MyList(M, 2) = Range("C" & N)
MyList(M, 3) = Range("D" & N)
End With
Next N
ListBox1.List = MyList()
End Sub

---

HTH

hello john,

Thank you for your time.
I am getting "run-time error '9': subscript out of range" error
in the line Workbooks("Data ListBox").Activate

Code:

---

Private Sub UserForm_Activate()
    Dim MyList(50, 4), M%, N%
    With ListBox1
        .ColumnCount = 4
        .ColumnWidths = "33pt;33pt;33pt;33pt"
        .Width = 160
        .Height = 120
        .BoundColumn = 1
    End With
    For N = 1 To 50
        M = N - 1
        Application.ScreenUpdating = False
        Workbooks("Data ListBox").Activate
        With ActiveWorkbook.Worksheets("Sheet1")
            MyList(M, 0) = Range("A" & N)
            MyList(M, 1) = Range("B" & N)
            MyList(M, 2) = Range("C" & N)
            MyList(M, 3) = Range("D" & N)
        End With
    Next N
    ListBox1.List = MyList()
 End Sub

---

Try this:

Code:

---

Workbooks("Data ListBox.xls").Activate

---

? Not getting that with my copy ?

I've zipped my copy and attached it below - see if that gives the same problem.

PS you're not closing the other book after it activates are you? - That'll do it.

Also, to keep the book "List Box" on top, change the code in the UserForm module from:

Code:

---

ListBox1.List = MyList()
End Sub

---

To this:

Code:

---

ListBox1.List = MyList()
Workbooks("List Box").Activate
End Sub

---

I am getting the same problem.
Can we populate the listbox without having to open the other file?

Ok, Seeing as you're (apparently) not erroring out on the workbook.open that's in Module1, let's try it this way:

Code:

---

Public Sub CallDialog()
      UserForm1.Show
End Sub

---

And in the Userform module

Code:

---

Private Sub UserForm_Activate()
Dim MyList(50, 4), M%, N%
With ListBox1
            .ColumnCount = 4
            .ColumnWidths = "33pt;33pt;33pt;33pt"
            .Width = 160
            .Height = 120
            .BoundColumn = 1
      End With
      Application.ScreenUpdating = False
      Application.Workbooks.Open("c:/Windows/Desktop" & _
                                      "/Data ListBox.xls").Activate
      For N = 1 To 50
            M = N - 1
            With ActiveWorkbook.Worksheets("Sheet1")
                  MyList(M, 0) = Range("A" & N)
                  MyList(M, 1) = Range("B" & N)
                  MyList(M, 2) = Range("C" & N)
                  MyList(M, 3) = Range("D" & N)
            End With
      Next N
      ListBox1.List = MyList()
      ActiveWorkbook.Close
      Workbooks("List Box").Activate
End Sub

---

Oh, as to the 2nd part of your question surya, the only way I know of to get the data without opening the other book is to paste links from it to the open book and use the linked data in the ListBox book to populate the list box itself.

The problem then is that you get this really annoying (and time-consuming) message about Updating links every time you open your ListBox book, and the links also use up more memory.(There may be others who know a different way of getting data from the closed book, but I don't).

For example, if you paste your links in (say) the columns AA, AB, AC, and AD the userform code would then become this:

Code:

---

Private Sub UserForm_Activate()
Dim MyList(50, 4), M%, N%
With ListBox1
.ColumnCount = 4
.ColumnWidths = "33pt;33pt;33pt;33pt"
.Width = 160
.Height = 120
.BoundColumn = 1
End With
For N = 1 To 50
M = N - 1
MyList(M, 0) = Range("AA" & N)
MyList(M, 1) = Range("AB" & N)
MyList(M, 2) = Range("AC" & N)
MyList(M, 3) = Range("AD" & N)
Next N
ListBox1.List = MyList()
End Sub

---

HTH

Hello John,

thank you, the error is gone.

1) I am wondering if it is possible to populate the list box based on the radio button selection.

2) When the user selects, Roof radio button only the data containing Roof in Data listbox.xls should be selected. Similarly for Roof and Wall. (probably if condition has to be used here)

3) Once the user makes the selection, the selection has to be copied into listbox.xls in sheet1. For example, the user has selected

Part 6, Part 14, Part 15
Part 3, Part 4
Part 6, Part 17, Part 18, Part 19

The above has to transferred to listbox.xls. You will notice that the data is summarised as per type category such as Floor, Roof or Wall.

thanks
prakash

Quote:

---

Originally Posted by surya prakash

Hello John,

thank you, the error is gone.

1) I am wondering if it is possible to populate the list box based on the radio button selection.

2) When the user selects, Roof radio button only the data containing Roof in Data listbox.xls should be selected. Similarly for Roof and Wall. (probably if condition has to be used here)

3) Once the user makes the selection, the selection has to be copied into listbox.xls in sheet1. For example, the user has selected

Part 6, Part 14, Part 15
Part 3, Part 4
Part 6, Part 17, Part 18, Part 19

The above has to transferred to listbox.xls. You will notice that the data is summarised as per type category such as Floor, Roof or Wall.

thanks
prakash

---

Hi prakash,

Shouldn't be much of a problem, but can you do up (and zip) a demo sheet with how and where on the sheet you want this to be displayed - i.e. exactly what has been selected and what you want your final output to look like on the sheet.

Also, you say the error's gone now, so are you now referring to the linked method I posted last as a PS, or the method I posted immediately before that? (Just so I know what method I have to work with).

John

Hello John

I used your other approach (non-link method). I am attaching the files for your ready reference.

As you can see, the report is in the listbox.xls (with sheet name "report"), when the user makes the selection in the listbox the data should go into the report sheet, with the items in "type" sorted out.

I am attaching the working files for your ready reference.

Thanks

prakash

Hi prakash,

First, I had to rename your books, having a book named List Box can easily lead to errors...They're now named "ListBook" and "ListBookData".

I looked at several ways of doing this and decided the easiest way to go about it was to have a workbook open event to open "ListBookData" and copy the data in an unused part of the sheet (I chose columns AA, AB, AC, and AD) then delete all this copied data from the ListBook with a before close event. So this code goes in the "ThisWorkbook" module:

'//"ThisWorkbook" module code

Code:

---

Option Explicit
 
Private Sub Workbook_Open()
Application.ScreenUpdating = False
On Error Resume Next '<< if book is already open
Application.Workbooks.Open(ThisWorkbook.Path & "/ListBookData").Activate
'//open ListBookData following your path
'Application.Workbooks.Open("G:/Desktop NT/VBA/EXAMPLES" & _
"/ListBookData.xls").Activate
Windows("ListBookData.xls").Activate
Columns("A:D").Select
Selection.Copy
Windows("ListBook.xls").Activate
Columns("AA:AD").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.LargeScroll Down:=-10
ActiveWindow.LargeScroll ToRight:=-10
Range("A1").Select
Workbooks("ListBookData.xls").Close
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
Columns("AA:AD").Select
With Selection
.ClearContents
.Interior.ColorIndex = xlNone
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
End Sub

---

And this code goes into the UserForm module:

'//"UserForm1" module code

Code:

---

Option Explicit
Public Chosen$
 
Private Sub UserForm_Activate()
Dim MyList(50, 4), M%, N%
With ListBox1
.ColumnCount = 4
.ColumnWidths = "35pt;35pt;35pt;35pt"
.Width = 160
.Height = 120
.BoundColumn = 1
End With
DoEvents
Application.ScreenUpdating = False
For N = 1 To 50
M = N - 1
With ActiveSheet
'//put the entire selection in list box
MyList(M, 0) = Range("AA" & N)
MyList(M, 1) = Range("AB" & N)
MyList(M, 2) = Range("AC" & N)
MyList(M, 3) = Range("AD" & N)
End With
Next N
ListBox1.List = MyList()
End Sub
 
Private Sub optFloor_Click()
If optFloor = True Then
Chosen = "Floor"
DoShortList
End If
End Sub
 
Private Sub optRoof_Click()
If optRoof = True Then
Chosen = "Roof"
DoShortList
End If
End Sub
 
Private Sub optWall_Click()
If optWall = True Then
Chosen = "Wall"
DoShortList
End If
End Sub
 
Private Sub DoShortList()
Dim MyList(50, 4), N%
'//(n.b. listbox size etc. is setup on "UserForm_Activate")
Application.ScreenUpdating = False
With ActiveSheet
'//put headings in list box
MyList(0, 0) = Range("AA1")
MyList(0, 1) = Range("AB1")
MyList(0, 2) = Range("AC1")
MyList(0, 3) = Range("AD1")
End With
Range("AA2").Activate
N = 1
Do Until Selection = Empty
'//put selected type in list box
If ActiveCell.Offset(0, 1) = Chosen Then
MyList(N, 0) = ActiveCell
MyList(N, 1) = ActiveCell.Offset(0, 1)
MyList(N, 2) = ActiveCell.Offset(0, 2)
MyList(N, 3) = ActiveCell.Offset(0, 3)
N = N + 1
End If
ActiveCell.Offset(1, 0).Activate
Loop
ListBox1.List = MyList()
End Sub
 
Private Sub cmdInsert_Click()
'//inserts the required data where you wanted it
Dim MyList(50, 4), M%, N%
If optFloor = False And optWall = False And _
optRoof = False Then GoTo IsError
Application.ScreenUpdating = False
'//copy and paste heading
Range("AA1:AD1").Select
Selection.Copy
If Range("A1") = Empty Then
Range("A1").Select
Else
Range("A65536").End(xlUp).Offset(11, 0).Select
End If
ActiveSheet.Paste
'//now put the data below this
Range("AA2").Activate
N = 1
Do Until Selection = Empty
'//put selected type on sheet
If ActiveCell.Offset(0, 1) = Chosen Then
Range("A65536").End(xlUp).Offset(1, 0) = ActiveCell
Range("B65536").End(xlUp).Offset(1, 0) = ActiveCell.Offset(0, 1)
Range("C65536").End(xlUp).Offset(1, 0) = ActiveCell.Offset(0, 2)
Range("D65536").End(xlUp).Offset(1, 0) = ActiveCell.Offset(0, 3)
N = N + 1
End If
ActiveCell.Offset(1, 0).Activate
Loop
'//put the borders in
Range("A65536").End(xlUp).Activate
ActiveCell.CurrentRegion.Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
IsError:
Range("A1").Select
Unload Me
End Sub

---

The "G" drive had me foxed for a while, try this and if you get any more range reference errors use your original references.

Regards,
John

Hello John,

I am wondering if we can populate the data in the listbox without copying the data into listbox.xls. (the data is very large).

thanks
prakash

Hi prakash,

Yes, we certainly could populate the listbox without copying, but I see no real benefit in doing it that way... it would marginally speed up opening the ListBook but it would probably slow everything else down when you're actually running the "list" part of it.

(Note that although copying the data into the open book makes the open book "larger" while it is open, it takes up no more memory when it is closed as all this data is cleared from the open book with the BeforeClose event).

Let me know...

Regards,
John

Hello John,

You are right that the macro will run faster when it is copied, but for my academic interest can you please show me how I could populate the listbox directly from a excel file without having to copy the data.

thanks
prakash

Hi prakash,

This's another way of doing it...This doesn't copy the entire data when the book is opened, it just copies the items you 'select', so you don't need the workbook open and before close events (it's simpler to do a copy of SOME sort, otherwise you need code to do all the formatting - e.g. the previous one did the formatting for borders):

'//"UserForm1" module code

Code:

---

Option Explicit
Public Chosen$
 
Private Sub UserForm_Activate()
Dim MyList(50, 4), M%, N%
With ListBox1
.ColumnCount = 4
.ColumnWidths = "35pt;35pt;35pt;35pt"
.Width = 160
.Height = 120
.BoundColumn = 1
End With
DoEvents
Application.ScreenUpdating = False
On Error Resume Next
Application.Workbooks.Open (ThisWorkbook.Path & _
"/ListBookData")
Workbooks("ListBoxData").Activate
Worksheets("Sheet1").Activate
For N = 1 To 50
M = N - 1
With ActiveSheet
'//put the entire selection in list box
MyList(M, 0) = Range("A" & N)
MyList(M, 1) = Range("B" & N)
MyList(M, 2) = Range("C" & N)
MyList(M, 3) = Range("D" & N)
End With
Next N
ListBox1.List = MyList()
ActiveWindow.WindowState = xlMinimized
Workbooks("ListBook").Activate
Worksheets("Report").Activate
End Sub
 
Private Sub optFloor_Click()
If optFloor = True Then
Chosen = "Floor"
DoShortList
End If
End Sub
 
Private Sub optRoof_Click()
If optRoof = True Then
Chosen = "Roof"
DoShortList
End If
End Sub
 
Private Sub optWall_Click()
If optWall = True Then
Chosen = "Wall"
DoShortList
End If
End Sub
 
Private Sub DoShortList()
Dim MyList(50, 4), N%
'//(n.b. listbox sixe etc. is setup on "UserForm_Activate")
Application.ScreenUpdating = False
Windows("ListBookData").Activate
With ActiveSheet
'//put headings in list box
MyList(0, 0) = Range("A1")
MyList(0, 1) = Range("B1")
MyList(0, 2) = Range("C1")
MyList(0, 3) = Range("D1")
End With
Range("A2").Activate
N = 1
Do Until Selection = Empty
'//put selected type in list box
If ActiveCell.Offset(0, 1) = Chosen Then
MyList(N, 0) = ActiveCell
MyList(N, 1) = ActiveCell.Offset(0, 1)
MyList(N, 2) = ActiveCell.Offset(0, 2)
MyList(N, 3) = ActiveCell.Offset(0, 3)
N = N + 1
End If
ActiveCell.Offset(1, 0).Activate
Loop
ListBox1.List = MyList()
End Sub
 
Private Sub cmdInsert_Click()
'//inserts the required data where you wanted it
Dim N%
If optFloor = False And optWall = False And _
optRoof = False Then GoTo IsError
Application.ScreenUpdating = False
'//copy and paste heading
Windows("ListBookData.xls").Activate
Range("A1:D1").Select
Selection.Copy
Windows("ListBook.xls").Activate
If Range("A1") = Empty Then
Range("A1").Select
Else
Range("A65536").End(xlUp).Offset(11, 0).Select
End If
ActiveSheet.Paste
Application.CutCopyMode = False
'//now get the data to put below this
Windows("ListBookData.xls").Activate
Range("A2").Activate
N = 1
Do Until Selection = Empty
'//paste selected type on ListBook sheet
If ActiveCell.Offset(0, 1) = Chosen Then
Range(ActiveCell, ActiveCell.Offset(0, 3)).Copy
Windows("ListBook.xls").Activate
Range("A65536").End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlValues
Selection.PasteSpecial Paste:=xlFormats
'//clear the clipboard
Application.CutCopyMode = False  '<< edited to inlude this (forgotten)
Range("A1").Select
N = N + 1
End If
'//get the next one
Windows("ListBookData.xls").Activate
ActiveCell.Offset(1, 0).Activate
Loop
IsError:
Range("A1").Select
Unload Me
Workbooks("ListBookData").Close
End Sub

---

Hello John,
Thank you very much for your help.
I have noticed the following:
1) The workbook is getting minimsed (half closed)
2) Can I select multiple data in the listbox on different radio buttun clicks (wall, floor etc)
3) Only the selected data should go the report sheet.

thanks
prakash

Hi prakash,

1) I minimized the ListBookData book as a means of effectively "hiding" the ListBookData book while working with the visible book (i.e. the ListBook). This minimizing doesn't (or shouldn't) affect the ListBook itself.

2) The way it's set up you can only select one class of data at a time.

3) Yes, only the selected class of data will go to the ListBook sheet. The whole thing would have to be modified to select two classes.

John

Hello John,

The listbookdata.xls, which contains the data for populating the listbox is available to users on a network; I am wondering, if the invisible filesharing might create some problems.

Also, after populating the listbox, (I changed the multiselect property of the listbox to fmMultiSelectExtended), the insert command is not copying the multiple selection that I made in the list box. Can you please check.

thanks
prakash