Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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? |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Ok, but I know very little with coding stuff, so I need a hand with this. :)
"galimi" wrote: The File System Object will allow you to do this with very little coding. -- http://www.ExcelHelp.us 888-MY-ETHER ext. 01781474 "miker" wrote: 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? |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 wrote: 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? -- Dave Peterson |
#5
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#6
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
I'm not sure I understand, but in the code I suggested earlier, you could make a
change: myMonthName = "Sheet1" becomes myMonthName = Activesheet.name miker wrote: 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 |
#7
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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. miker wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Help with script Please | Excel Programming | |||
VBA, VB Script and VB | Excel Programming | |||
help with the VB script | Excel Worksheet Functions | |||
Excel 2000/XP script to Excel97 script | Excel Programming | |||
what is a vb script | Excel Programming |