PDA

View Full Version : Solved: [SOLVED] List Files & Cell Values With Specific Sheet Names From ListBox



xfr79
12-05-2008, 08:18 AM
I have this script below. Let me explain what it does.
Lets say I?m working on worksheet ?MARCH?. When I call the script, it opens up a userform window. It proceeds to search a specific directory for workbooks that also contain the worksheet ?MARCH?. When it finishes it?s search, it displays the workbooks in listbox1 that contain a worksheet named ?MARCH?. If I were to double click the workbook, it would display the worksheet from that workbook in listbox2. If I wanted to view the sheet, I would select the worksheet from listbox2 and hit a button to open the workbook up.
I?m at a lost here with what I?m trying to achieve.
Along with the worksheet name, I also want cell data from that worksheet to be displayed with it. For instance, I want data from cells C16 and E16 to be along side the worksheet name . I?m wanting it to look something like this in listbox2:
?Worksheet Name TT:?data from cell C16? TA:?data from cell E16??

Any suggestions?



Public FilePath As String
Public dic As Object
Public oWB As String
Public oWS As String
Public aWS As Worksheet
Private Sub CommandButton1_Click()
Dim i As Long, wb As Workbook, n As Long
With Me.ListBox2
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
oWS = .list(i)
Set wb = Workbooks.Open(FilePath & oWB, UpdateLinks:=0)
wb.Sheets(oWS).Activate
Exit For
End If
Next
End With
End Sub
Private Sub CommandButton3_Click()
Set dic = Nothing
Unload Me
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim i As Long, w(), j As Long, s()
With Me
.ListBox2.Clear
For i = 0 To .ListBox1.ListCount - 1
If .ListBox1.Selected(i) = True Then
.ListBox2.AddItem aWS.Name

oWB = .ListBox1.list(i)
End If
Next
End With
End Sub

Private Sub UserForm_Initialize()
Dim FileList(), i As Long, n As Long, fName As String, shtName()
Dim wb As Workbook, ws As Worksheet

Set dic = CreateObject("scripting.dictionary")
dic.comparemode = vbTextCompare
FilePath = "C:\excelfiles\"
Userform1.Caption = "List of xls files in " & FilePath
fName = Dir(FilePath & "*.xls")
Set aWS = ActiveSheet
On Error GoTo Xit
With Application
.ScreenUpdating = 0
.EnableEvents = 0
.DisplayAlerts = 0
End With
i = 1:
Do While fName <> ""
If fName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(FilePath & fName, UpdateLinks:=0)
For Each ws In wb.Worksheets
If ws.Name = aWS.Name Then
If Not dic.exists(fName) Then
dic.add fName, ws.Name
Exit For
End If
End If
Next
wb.Close False: Set wb = Nothing
End If
fName = Dir()
Loop
With Me.ListBox1
.Clear
.list = dic.keys
End With
Xit:
With Application
.ScreenUpdating = 1
.EnableEvents = 1
.DisplayAlerts = 1
End With
End Sub

mdmackillop
12-05-2008, 12:41 PM
In order to populate your form, either
Excel has to open and read data from each workbook
or
Read the data from closed workbooks.

Both of these can be time consuming. Why not maintain an index file with all workbooks/months/cell data which can be used to populate the listbox. Then you can more easily access the correct sheet.

xfr79
12-05-2008, 12:46 PM
the script opens each workbook up and collects the data, then closes the workbook. Below is the part of the script that does that.



Set dic = CreateObject("scripting.dictionary")
dic.comparemode = vbTextCompare
FilePath = "C:\excelfiles\"
Userform1.Caption = "List of xls files in " & FilePath
fName = Dir(FilePath & "*.xls")
Set aWS = ActiveSheet
On Error GoTo Xit
With Application
.ScreenUpdating = 0
.EnableEvents = 0
.DisplayAlerts = 0
End With
i = 1:
Do While fName <> ""
If fName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(FilePath & fName, UpdateLinks:=0)
For Each ws In wb.Worksheets
If ws.Name = aWS.Name Then
If Not dic.exists(fName) Then
dic.add fName, ws.Name
Exit For
End If
End If
Next
wb.Close False: Set wb = Nothing
End If

Kenneth Hobs
12-05-2008, 01:32 PM
I don't have time to work up a full example. There are 2 methods that I would consider. (1) ADO using adSchemaTables or (2) this one.

In this method, you can use On Error to skip those workbooks that don't have that sheet when you try to get the value from the closed workbook. Since debug.print does not prompt you, you can use it as part of your error check or check for the sheet names existance in other words. Use this to decide whether to add the workbook name to the dictionary or not.

Sub test()
debug.print GetValue("c:\", "test.xls", "Sheetx", "A1")
End Sub

'=GetValue("c:\files", "budget.xls", "Sheet1", "A1")
Private Function GetValue(path, file, sheet, ref)
' path = "d:\files"
' file = "budget.xls"
' sheet = "Sheet1"
' ref = "A1:R30"

Dim arg As String

If Right(path, 1) <> "\" Then path = path & "\"

If Dir(path & file) = "" Then
GetValue = "file not found"
Exit Function
End If

arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("a1").Address(, , xlR1C1)

GetValue = ExecuteExcel4Macro(arg)
End Function

xfr79
12-05-2008, 02:25 PM
Great!
I used your example. It's working thew way I want it to now!
:beerchug:

Kenneth Hobs
12-05-2008, 02:55 PM
Great!

If you don't mind, can you please post the code that works for you now and then mark this thread solved?

xfr79
12-05-2008, 02:59 PM
Sub test()


Debug.Print GetValue("c:\", "test.xls", "Sheetx", "A1")

End Sub


'=GetValue("c:\files", "budget.xls", "Sheet1", "A1")
Private Function GetValue(path, file, sheet, ref)
' path = "d:\files"
' file = "budget.xls"
' sheet = "Sheet1"
' ref = "A1:R30"


Dim arg As String


If Right(path, 1) <> "\" Then path = path & "\"


If Dir(path & file) = "" Then
GetValue = "file not found"
Exit Function
End If


arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("a1").Address(, , xlR1C1)


GetValue = ExecuteExcel4Macro(arg)
End Function