script help!

[miker]

i'm trying to modify this script:


Private Sub UserForm_Initialize()

Dim FileList(), i As Long, x, n As Long, fName As String

FilePath = "F:\Sec\History\" 'change to suit

fName = Dir(FilePath & "*.xls")

i = 1

Do While fName <> ""

ReDim Preserve FileList(1 To i)

FileList(i) = fName

i = i + 1

fName = Dir()

Loop

ReDim Preserve FileList(1 To i - 1)

With Me.ListBox1

.Clear

.List = FileList

End With

End Sub


What i'm trying to do is, lets say i'm working on sheet "MARCH" and I want
to see what other workbooks in directory F:\Sec\History\ contain the
worksheet "MARCH". I want the listbox to show the workbooks that do contain
the worksheet and ignore the other workbooks that do not . I have a command
button that opens up the selected workbook:


Private Sub CommandButton1_Click()

Dim i As Long, wb As Workbook

With Me.ListBox1

For i = 0 To .ListCount - 1

If .Selected(i) = True Then

Set wb = Workbooks.Open(FilePath & .List(i), UpdateLinks:=0)

wb.Activate

Exit For

End If

Next

End With

End Sub



Is it possible I can get it work work this way?

 

[galimi]

The File System Object will allow you to do this with very little coding.

 

[miker]

Ok, but I know very little with coding stuff, so I need a hand with this.

 

[Dave Peterson]

This may get you started:

Option Explicit
Private Sub UserForm_Initialize()

Dim myNames() As String
Dim okNames() As String
Dim fCtr As Long
Dim okCtr As Long
Dim myFile As String
Dim myPath As String
Dim wks As Worksheet
Dim TempWkbk As Workbook
Dim TestWks As Worksheet
Dim myMonthName As String 'from a textbox for you???

myMonthName = "Sheet1"

'change to point at the folder to check
myPath = "C:\my documents\excel\test"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

Application.ScreenUpdating = False

If fCtr > 0 Then
ReDim okNames(LBound(myNames) To UBound(myNames))
okCtr = 0
For fCtr = LBound(myNames) To UBound(myNames)

Application.EnableEvents = False 'stop workbook_Open
Set TempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr), _
ReadOnly:=True, UpdateLinks:=0)
Application.EnableEvents = True

Set TestWks = Nothing
On Error Resume Next
Set TestWks = TempWkbk.Worksheets(myMonthName)
On Error GoTo 0

If TestWks Is Nothing Then
'not found
Else
okCtr = okCtr + 1
okNames(okCtr) = TempWkbk.Name '.fullname???
End If

Application.EnableEvents = False 'stop workbook_beforeclose
TempWkbk.Close savechanges:=False
Application.EnableEvents = True

Next fCtr

If okCtr > 0 Then
'found at least one
ReDim Preserve okNames(LBound(okNames) To okCtr)
With Me.ListBox1
.Clear
.List = okNames
End With
End If
End If

Application.ScreenUpdating = True

End Sub

 

[miker]

Hi Dave, thanks for the example.
I have this script that kind of does what I want. (shown below)
Let me explain what it does. When I hit a button, it runs the script, it has
two list boxes, on the left, and one on the right, after it does it run, it
list's all the workbooks in a specified directory on the left listbox. When I
double click on a workbook on the left, it lists all the worksheets in the
right listbox. If i wanted to view a sheet, I would click on a button to open
the workbook up and take me to the sheet.

Now, what I want it to do now is, lets say i'm on sheet "MARCH" and I hit a
button to run the script. I want all workbooks that contain the sheet
"MARCH" to be displayed on the left lsitbox. Then when I double click the
workbook, it will just display the worksheet on the right.

is that doable?

here is the full script:

Public FilePath As String
Public dic As Object
Public oWB As String
Public oWS As String
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 CommandButton2_Click()
Set dic = Nothing
Unload Me
End Sub


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim i As Long, w()
With Me
For i = 0 To .ListBox1.ListCount - 1
If .ListBox1.Selected(i) = True Then
w = dic.Item(.ListBox1.List(i))
With .ListBox2
.Clear
.List = w
End With
oWB = .ListBox1.List(i)
dic.Item(.ListBox1.List(i)) = w
Exit For
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 = "L:\Sec09\AttendanceHistory\"
UserForm1.Caption = "List of xls files in " & FilePath
fName = Dir(FilePath & "*.xls")

On Error GoTo Xit


With Application
.ScreenUpdating = 0
.EnableEvents = 0
.DisplayAlerts = 0
End With
i = 1:
Do While fName <> ""
If Not dic.exists(fName) Then
Set wb = Workbooks.Open(FilePath & fName, UpdateLinks:=0)
For Each ws In wb.Worksheets
n = n + 1
ReDim Preserve shtName(1 To n)
shtName(n) = ws.Name
Next
dic.Add fName, shtName
End If
wb.Close False: Set wb = Nothing
Erase shtName: n = 0
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

 

[Dave Peterson]

I'm not sure I understand, but in the code I suggested earlier, you could make a
change:

myMonthName = "Sheet1"
becomes
myMonthName = Activesheet.name

 

[Dave Peterson]

ps.

Instead of looping through all the files and worksheets multiple times, I think
I would use a hidden worksheet (in the workbook with the userform???).

Then depending on the number of expected files or the number of expected
worksheets per file, I'd create a table of filenames (in row 1) and worksheets
in that file (rows 2 to ###). (Or the same info transposed.)

Then I could just inspect those ranges to find the matching workbooks.