VBA Application.Filesearch workaround

[eeder1]

I REALLY need a fix for the application.filesearch function that is currently in some old code which works in Excel 2003 and before but not in Excel 2007. I have heard suggestions on fixing this by using the Dir function but with my limited knowledge and no time I need expertise...PLEASE HELP!!!!



Call GetBrowse 'goes to a sub that allows you to pick a file with multiple excel files...after running through it jumps back to the Application.Filesearch below and gets stuck due to it being removed from 2007
With Application.FileSearch
.NewSearch
.LookIn = strPath
.Filename = "*.xls"
If .Execute() > 0 Then
Workbooks.Add
WrWrkBk = ActiveWorkbook.Name
x = Workbooks(WrWrkBk).Worksheets.Count

sort = 8
For i = 1 To counter - 1
Application.ScreenUpdating = False
strfile = .FoundFiles(i)


Find_Last_Slash (strfile)
strfile = Mid(strfile, 1, position)
a = a + 1
strDiv = Workbooks(RdWrkBk1).Sheets(1).Cells(a, sort).Value
strfile = strfile & strDiv & ".xls"

Workbooks.Open strfile 'open workbook

Find_Last_Slash (strfile)
RdWrkBk = Trim(Mid(strfile, position + 1, 50))

 

[jindon]

should be

With Workbooks.Open(myFolder & fn, updatelinks:= false)

 

[eeder1]

Great that worked!!! With the old code at the very end after the one large file had been created an extra sheet was added at the front with Hyperlinks that had the name to each individual worksheet..i.e "Texas - Unit Waterfalls" which would go to position A1 of that worksheet and a "Home" hyperlink to go back to the Hyperlink sheet...I have the old code but it i will not let me put it at the end of your code

'HyperlinkIt WrWrkBk
Sub HyperlinkIt()
'Workbooks(CodeWrkBk).Close (False)
'Hyperlink all sheets in a file start with first sheet
Dim w As Worksheet
Workbooks(WrWrkBk).Worksheets(1).Activate
x = 1
Sheets.Add
ActiveSheet.Name = "Home"
For Each w In Worksheets
w.Rows(1).Insert Shift:=xlDown
ActiveSheet.Hyperlinks.Add anchor:=ActiveSheet.Cells(x, 1), Address:="", SubAddress:="'" & w.Name & "'!A1", TextToDisplay:=w.Name
w.Hyperlinks.Add anchor:=w.Cells(1, 1), Address:="", SubAddress:="'" & ActiveSheet.Name & "'!A1", TextToDisplay:=ActiveSheet.Name
x = x + 1
Next
Sheets("Home").Rows("1:1").AutoFilter
Sheets("Home").Columns("A:A").ColumnWidth = 27.71
End Sub

Thanks a ton for all your help and if you can do this I will quit bugging you

 

[jindon]

add following code just before End Sub

    n = 0
    wb.Sheets.Add.Name = "Home"
    For Each ws In wb.Sheets
        If ws.Name <> "Home" Then
            n = n + 1
            With wb.Sheets("Home").Cells(n, 1)
                .HyperLiks.Add Anchor:=.Cells, Address:="'" & ws.Name & "'!A1", _
                TextToDisplayws.Name 
            End With
        End If
    Next

 

[eeder1]

Hey Jindon! Once again thanks for your help yesterday..can give me an example on how to set print areas for each individual worksheets ("5
Year Forecast' and "FY 2009 Snapshot")?
For example if the worksheet contains "5 Year Forecast" then set print area to $A$1:$X$77 and worksheet contains "Fy 2009 Snapshot" then set print area to $A$1:$Y$72..I need to adjust column widths as well..many thanks..Eeder

Sub Consolidate()
Dim myFolder As String, fn As String, wb As Workbook, n As Long
Dim mySheet, myRange As String, r As Range, rng As Range, e
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = True Then
        myFolder = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With
myFolder = myFolder & "\"
mySheet = Array("5 Year Forecast", "FY 2009 Snapshot")
myRange = "A1:Z100"
Set wb = Workbooks.Add
With ThisWorkbook.Sheets(1)
    Set rng = .Range("h7", .Range("h" & Rows.Count).End(xlUp))
End With
For Each r In rng
    fn = Dir(myFolder & r.value & ".xls", vbNormal)
    If fn = "" Then
        MsgBox "No such file named " & r.value & ".xls in " & myFolder
    Else
        With Workbooks.Open(myFolder & fn, UpdateLinks:=False)
        
            For Each e In mySheet
                n = n + 1
                If n > wb.Sheets.Count Then wb.Sheets.Add after:=wb.Sheets(n - 1)
                .Sheets(e).Range(myRange).Copy wb.Sheets(n).Cells(1)
                'wb.Sheets(n).Cells.value = wb.Sheets(n).Cells.value ''was causing issues
                Application.CutCopyMode = False
                On Error Resume Next
                wb.Sheets(n).Name = r.value & " - " & e
                If Err <> 0 Then
                    MsgBox r.value & " - " & e & " can't be used for a sheet name"
                End If
                On Error GoTo 0
            Next
            .Close False
                                
        End With
         
    End If
Next
x = 1
Sheets.Add
ActiveSheet.Name = "Home"
Sheets("Home").Select
Sheets("Home").Move Before:=Sheets(1)
For Each w In Worksheets
    w.Rows(1).Insert Shift:=xlDown
    ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(x, 1), Address:="", SubAddress:="'" & w.Name & "'!A1", TextToDisplay:=w.Name
    w.Hyperlinks.Add Anchor:=w.Cells(1, 1), Address:="", SubAddress:="'" & ActiveSheet.Name & "'!A1", TextToDisplay:=ActiveSheet.Name
    x = x + 1
Next
  Sheets("Home").Rows("1:1").AutoFilter
  Sheets("Home").Columns("A:A").ColumnWidth = 27.71
  
  End Sub

 

[jindon]

Sub example()
Dim ws As Worksheet, myPrintArea As String
For Each ws In Sheets
    Select Case True
        Case ws.Name Like "*5 Year Forecast"
            myPrintArea = "$A$1:$X$77"
        Case ws.Name Like "*FY 2009 Snapshot"
            myPrintArea = "$A$1:$Y$72"
    End Select
    If myPrintArea <> "" Then ws.PageSetup.PrintArea = myPrintArea
    myPrintArea = ""
Next
End Sub

 

[eeder1]

That worked great..to add things like column width adjusting, letter or legal would you have to call separate subs or can you build it in?

Sub example2()
Dim ws As Worksheet, mycolumnwidth As String
For Each ws In Sheets
    Select Case True
        Case ws.Name Like "*5 Year Forecast"
            mycolumnwidth = Columns("A:Z").Select
            Selection.Columns.AutoFit
            
                                   
                   Case ws.Name Like "*FY 2009 Snapshot"
            mycolumnwidth = Columns("A:Z").Select
            Selection.Columns.AutoFit
            
    End Select
    If mycolumnwidth <> ColumnWidth * 11 Then ws.Selection.ColumnWidth = mycolumnwidth
    mycolumnwidth = ""

I tried to call this code but with no luck but I would rather build it all in one sub if possible?? Thanks

 

[jindon]

I can not help you, because your code doesn't explain what you are trying to do.
Doesn't make sense to me.

 

[eeder1]

Ideally what I would like to do would be to incorporate your code below to include things like column width, pagesetup functions etc for example.

My file will vary with number of sheets but I need to highlight or select all of those sheets and select columns ($A:$Z) and autosize them or make them an exact column width say "11". Also need to make all of the sheets set to print on legal paper & adjust margins righth and left to .25 . If this can be incorporated in the code below if not I guess another sub to call that would accomplish this...thanks again for looking.

Sub example()
Dim ws As Worksheet, myPrintArea As String
For Each ws In Sheets
    Select Case True
        Case ws.Name Like "*5 Year Forecast"
            myPrintArea = "$A$1:$X$77"
        Case ws.Name Like "*FY 2009 Snapshot"
            myPrintArea = "$A$1:$Y$72"
    End Select
    If myPrintArea <> "" Then ws.PageSetup.PrintArea = myPrintArea
    myPrintArea = ""
Next
End Sub

 

[eeder1]

Sorry forgot to tag code

Sub example()
Dim ws As Worksheet, myPrintArea As String
For Each ws In Sheets
Select Case True
Case ws.Name Like "*5 Year Forecast"
myPrintArea = "$A$1:$X$77"
Case ws.Name Like "*FY 2009 Snapshot"
myPrintArea = "$A$1:$Y$72"
End Select
If myPrintArea <> "" Then ws.PageSetup.PrintArea = myPrintArea
myPrintArea = ""
Next
End Sub

<!-- / message -->

 

[jindon]

set to print on legal paper & adjust margins righth and left to .25

Just record a macro for yourself...

try

Sub example()
Dim ws As Worksheet, myPrintArea As String
For Each ws In Sheets
    Select Case True
        Case ws.Name Like "*5 Year Forecast"
            myPrintArea = "$A$1:$X$77"
        Case ws.Name Like "*FY 2009 Snapshot"
            myPrintArea = "$A$1:$Y$72"
    End Select
    If myPrintArea <> "" Then
        ws.PageSetup.PrintArea = myPrintArea
        ws.Columns("A:Z").AutoFilt
        ' or
        'ws.Columns("A:Z").ColumnWidth = 11
    myPrintArea = ""
Next
End Sub