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

[xfr79]

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]

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]

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]

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.

[vba]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[/vba]

[xfr79]

Great!
I used your example. It's working thew way I want it to now!

[Kenneth Hobs]

Great!

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

[xfr79]

 
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