Sorry I hear you...this is inherited code but I know what the end result needs to be.
Basically within an excel path there are numerous excel files that contain one worksheet (all same format and # of rows) and I need all of those worksheets compiled into one workbook.
Code starts off as below...The Call GetBrowse goes into alot of code to give me a file directory pop-up..I then select my path and then it jumps back to the Application.Filesearch when I insert the Dir Function it kind of walks me through but then stops at strfile =.foundfiles(i) and starts giving me multiple errors...I wish I could unravel this but I am a beginner in VBA with no time right now...thanks for looking and I can send the Call GetBrowse code if needed
Private Sub CommandButton1_Click()
Dim i As Integer
Dim RdWrkBk As String
Dim WrWrkBk As String
Dim CodeWrkBk As String
Dim a As Integer
Dim sort As Integer
a = 6
CodeWrkBk = ActiveWorkbook.Name
Application.DisplayAlerts = False
Application.ScreenUpdating = True
RdWrkBk1 = ActiveWorkbook.Name
counter = 0
Do
test = Workbooks(CodeWrkBk).Worksheets("1").Cells(7 + counter, 8)
counter = counter + 1
Loop Until test = ""
Call GetBrowse
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) 'code in red at bottom
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))
newname = "Unit Waterfalls-" & Workbooks(RdWrkBk1).Sheets(1).Cells(i + 6, 9).Value
Workbooks(RdWrkBk).Sheets("Unit Waterfalls").Copy after:=Workbooks(WrWrkBk).Sheets(Workbooks(WrWrkBk).Sheets.Count)
Workbooks(WrWrkBk).Sheets(Workbooks(WrWrkBk).Sheets.Count).Name = newname
Workbooks(WrWrkBk).Sheets(Workbooks(WrWrkBk).Sheets.Count).Cells(2, 1).Value = Workbooks(RdWrkBk1).Sheets(1).Cells(i + 6, 8).Value
' add back for normal report' Workbooks(WrWrkBk).Sheets(Workbooks(WrWrkBk).Sheets.Count).Rows(1).Delete
'Workbooks(WrWrkBk).Sheets(Workbooks(WrWrkBk).Sheets.Count).Range("B72").Value = "proj.summarystatus='owned' or proj.summarystatus='likely' or proj.budget2008='Y' "
Workbooks(RdWrkBk1).Sheets(1).Cells(i + 6, 11).Value = Workbooks(RdWrkBk).Sheets("Unit Waterfalls").Cells(10, 6).Value
Workbooks(WrWrkBk).Worksheets(newname).PageSetup.PrintArea = "$A$1:$W$67"
Workbooks(WrWrkBk).Worksheets(newname).PageSetup.PrintArea = "$A$1:$W$67"
Workbooks(WrWrkBk).Worksheets(newname).Columns("B:M").ColumnWidth = 18.2
Workbooks(WrWrkBk).Worksheets(newname).Columns("N:N").ColumnWidth = 13.1
Workbooks(WrWrkBk).Worksheets(newname).Columns("O:S").ColumnWidth = 18.2
Workbooks(WrWrkBk).Worksheets(newname).Columns("T:T").ColumnWidth = 2.1
Workbooks(WrWrkBk).Worksheets(newname).Columns("U:U").ColumnWidth = 18
Workbooks(WrWrkBk).Worksheets(newname).Rows("8:65").RowHeight = 15
'newname = "FY08 Snpsht - " & Workbooks(RdWrkBk1).Sheets(1).Cells(i + 6, 9).Value
''Workbooks(RdWrkBk).Sheets("FY 2008 Snapshot").Copy after:=Workbooks(WrWrkBk).Sheets(Workbooks(WrWrkBk).Sheets.Count)
'Workbooks(WrWrkBk).Sheets(Workbooks(WrWrkBk).Sheets.Count).Name = newname
'Workbooks(WrWrkBk).Sheets(Workbooks(WrWrkBk).Sheets.Count).Cells(4, 1).Value = Workbooks(RdWrkBk1).Sheets(1).Cells(i + 6, 8).Value
'Workbooks(WrWrkBk).Sheets(Workbooks(WrWrkBk).Sheets.Count).Cells(2, 1).Value = "FY 2008 Snapshot"
' Workbooks(WrWrkBk).Sheets(Workbooks(WrWrkBk).Sheets.Count).Rows(1).Delete
' Workbooks(WrWrkBk).Sheets(Workbooks(WrWrkBk).Sheets.Count).Range("B76").Value = "proj.summarystatus='owned' or proj.summarystatus='likely' or proj.budget2008='Y' "
' Workbooks(RdWrkBk1).Sheets(1).Cells(i + 6, 13).Value = Workbooks(RdWrkBk).Sheets("FY 2008 Snapshot").Cells(10, 3).Value
'Workbooks(WrWrkBk).Worksheets(newname).PageSetup.PrintArea = "$A$1:$Z$76"
Workbooks(RdWrkBk).Close ' close workbook
x = x + 1
Next i
Workbooks(WrWrkBk).Worksheets("Sheet1").Delete
Workbooks(WrWrkBk).Worksheets("Sheet2").Delete
Workbooks(WrWrkBk).Worksheets("Sheet3").Delete
'End If
'End With
HyperlinkIt WrWrkBk
'Workbooks(CodeWrkBk).Close (False)
End Sub
Sub HyperlinkIt(WrWrkBk)
'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
Public Function Find_Last_Slash(wholestring As String) As Integer
Dim found_pos As Integer
Dim last_found As Integer
found_pos = 1
Do
found_pos = InStr(found_pos + 1, wholestring, "\", vbTextCompare)
If found_pos <> 0 Then
last_found = found_pos
End If
Loop While found_pos <> 0
position = last_found
End Function