Ref the line: MyPath = "C:\" in the sub below (from Mike H)
how can I make the path (the "C:\" bit) as a variable for the sub/Excel to
pick up? The path will be different everyday. I'd navigate to the desired
folder upon running the sub (via a "FileOpen"), then the sub will do the
rest of the processes on the files in that folder. Thanks.

Sub LoopThroughDirectory()
Application.DisplayAlerts = False
'Change this to your directory
MyPath = "C:\"
Dim wbNew As Workbook
Set wbNew = Workbooks.Add()
wbNew.SaveAs Filename:=MyPath & "1234.xls"
For x = 1 To 4
Workbooks.Open Filename:=MyPath & x & ".xls"
'Here is the line that calls the macro below, passing the workbook to it
DoSomething ActiveWorkbook
ActiveWorkbook.Close savechanges:=False
Next
Application.DisplayAlerts = True
End Sub

Change

MyPath = "C:\"

to this:

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Show
mypath = fd.SelectedItems(1)

"Max" wrote:

Ref the line: MyPath = "C:\" in the sub below (from Mike H)
how can I make the path (the "C:\" bit) as a variable for the sub/Excel to
pick up? The path will be different everyday. I'd navigate to the desired
folder upon running the sub (via a "FileOpen"), then the sub will do the
rest of the processes on the files in that folder. Thanks.

Sub LoopThroughDirectory()
Application.DisplayAlerts = False
'Change this to your directory
MyPath = "C:\"
Dim wbNew As Workbook
Set wbNew = Workbooks.Add()
wbNew.SaveAs Filename:=MyPath & "1234.xls"
For x = 1 To 4
Workbooks.Open Filename:=MyPath & x & ".xls"
'Here is the line that calls the macro below, passing the workbook to it
DoSomething ActiveWorkbook
ActiveWorkbook.Close savechanges:=False
Next
Application.DisplayAlerts = True
End Sub

Max, modified the macro to display the SaveAsDialog, and assign that file
path as myPath for you to proceed...Try and feedback

Sub LoopThroughDirectory()
Dim wbNew As Workbook, myPath As String, varFile As Variant

Application.DisplayAlerts = False
varFile = Application.GetSaveAsFilename
If varFile = False Then Exit Sub
myPath = Left(varFile, InStrRev(varFile, "\"))

Set wbNew = Workbooks.Add()
wbNew.SaveAs Filename:=varFile
For x = 1 To 4
Workbooks.Open Filename:=myPath & x & ".xls"
'Here is the line that calls the macro below, passing the workbook to it
' DoSomething ActiveWorkbook
ActiveWorkbook.Close savechanges:=False
Next
Application.DisplayAlerts = True

End Sub

If this post helps click Yes
---------------
Jacob Skaria


"Max" wrote:

Ref the line: MyPath = "C:\" in the sub below (from Mike H)
how can I make the path (the "C:\" bit) as a variable for the sub/Excel to
pick up? The path will be different everyday. I'd navigate to the desired
folder upon running the sub (via a "FileOpen"), then the sub will do the
rest of the processes on the files in that folder. Thanks.

Sub LoopThroughDirectory()
Application.DisplayAlerts = False
'Change this to your directory
MyPath = "C:\"
Dim wbNew As Workbook
Set wbNew = Workbooks.Add()
wbNew.SaveAs Filename:=MyPath & "1234.xls"
For x = 1 To 4
Workbooks.Open Filename:=MyPath & x & ".xls"
'Here is the line that calls the macro below, passing the workbook to it
DoSomething ActiveWorkbook
ActiveWorkbook.Close savechanges:=False
Next
Application.DisplayAlerts = True
End Sub

Nearly forgot, also change:

wbNew.SaveAs Filename:=MyPath & "1234.xls"


to just

wbNew.SaveAs Filename:=MyPath

"Sam Wilson" wrote:

Change

MyPath = "C:\"

to this:

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Show
mypath = fd.SelectedItems(1)

"Max" wrote:

Ref the line: MyPath = "C:\" in the sub below (from Mike H)
how can I make the path (the "C:\" bit) as a variable for the sub/Excel to
pick up? The path will be different everyday. I'd navigate to the desired
folder upon running the sub (via a "FileOpen"), then the sub will do the
rest of the processes on the files in that folder. Thanks.

Sub LoopThroughDirectory()
Application.DisplayAlerts = False
'Change this to your directory
MyPath = "C:\"
Dim wbNew As Workbook
Set wbNew = Workbooks.Add()
wbNew.SaveAs Filename:=MyPath & "1234.xls"
For x = 1 To 4
Workbooks.Open Filename:=MyPath & x & ".xls"
'Here is the line that calls the macro below, passing the workbook to it
DoSomething ActiveWorkbook
ActiveWorkbook.Close savechanges:=False
Next
Application.DisplayAlerts = True
End Sub

Thanks Jacob. Afraid I had difficulties trying it out. My original thread
where Mike responded is at: http://tinyurl.com/yewknly
Could I trouble you to check out my objectives/feedback to Mike (but I
received no further reply from Mike) over there, which might explain it
better? I need to fire the sub from somewhere independent (eg from
Personal.xls), then "point" it to the particular folder with the 4 files
(1.xls, 2.xls, 3.xls & 4.xls) and then leave the sub to do the rest of the
job ... creating a 1234.xls, saving this file into that particular folder,
and stack up all the data from 1.xls, 2.xls, 3.xls & 4.xls.

Thanks Sam. I'm afraid I had difficulties trying out your response.
My original thread where Mike responded is at: http://tinyurl.com/yewknly
Could I trouble you to check out my objectives/feedback to Mike (but I
received no further reply from Mike) over there, which might explain it
better? I need to fire the sub from somewhere independent (eg from
Personal.xls), then "point" it to the particular folder with the 4 files
(1.xls, 2.xls, 3.xls & 4.xls) and then leave the sub to do the rest of the
job ... creating a 1234.xls, saving this file into that particular folder,
and stack up all the data from 1.xls, 2.xls, 3.xls & 4.xls.

I thought I have responded..OK...I have read your responses to Mike in
MSwebnewsreader itself. If I understand you correctly the below would belp

'Modify your Sub as below; So that myPath is an argument be passed while
calling 'this sub
Sub LoopThroughDirectory(myPath as String)
'your code
End Sub

'From personal.xls
LoopThroughDirectory "C:\temp\"


If this post helps click Yes
---------------
Jacob Skaria


"Max" wrote:

Thanks Jacob. Afraid I had difficulties trying it out. My original thread
where Mike responded is at: http://tinyurl.com/yewknly
Could I trouble you to check out my objectives/feedback to Mike (but I
received no further reply from Mike) over there, which might explain it
better? I need to fire the sub from somewhere independent (eg from
Personal.xls), then "point" it to the particular folder with the 4 files
(1.xls, 2.xls, 3.xls & 4.xls) and then leave the sub to do the rest of the
job ... creating a 1234.xls, saving this file into that particular folder,
and stack up all the data from 1.xls, 2.xls, 3.xls & 4.xls.

Sub LoopThroughDirectory()

Application.DisplayAlerts = False

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Show
mypath = fd.SelectedItems(1) & "\"

Dim wbNew As Workbook
Set wbNew = Workbooks.Add()
wbNew.SaveAs Filename:=MyPath & "1234.xls"
For x = 1 To 4
Workbooks.Open Filename:=MyPath & x & ".xls"
'Here is the line that calls the macro below, passing the workbook to it
DoSomething ActiveWorkbook
ActiveWorkbook.Close savechanges:=False
Next
Application.DisplayAlerts = True
End Sub

"Max" wrote:

Thanks Sam. I'm afraid I had difficulties trying out your response.
My original thread where Mike responded is at: http://tinyurl.com/yewknly
Could I trouble you to check out my objectives/feedback to Mike (but I
received no further reply from Mike) over there, which might explain it
better? I need to fire the sub from somewhere independent (eg from
Personal.xls), then "point" it to the particular folder with the 4 files
(1.xls, 2.xls, 3.xls & 4.xls) and then leave the sub to do the rest of the
job ... creating a 1234.xls, saving this file into that particular folder,
and stack up all the data from 1.xls, 2.xls, 3.xls & 4.xls.

Many thanks, Sam. Tested using your revision on the sub and it works fine in
picking it up from the dialog, and proceeding from there.

Could I have your help here on the last bit, that stacking part carried out
by Mike's
Sub DoSomething(Book As Workbook). I've pasted below the entire routine
which I just tested. Somehow the stacking sub misses capturing 2 lines, which
I checked were the last data lines in 1.xls and 2.xls. For info, my test
source 3.xls had zero data lines (it had only the row1 col headers). Thanks

-------------------------
Sub LoopThroughDirectory()

Application.DisplayAlerts = False

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Show
myPath = fd.SelectedItems(1) & "\"

Dim wbNew As Workbook
Set wbNew = Workbooks.Add()
wbNew.SaveAs Filename:=myPath & "1234.xls"
For x = 1 To 4
Workbooks.Open Filename:=myPath & x & ".xls"
'Here is the line that calls the macro below, passing the workbook to it
DoSomething ActiveWorkbook
ActiveWorkbook.Close savechanges:=False
Next
Application.DisplayAlerts = True
End Sub

Sub DoSomething(Book As Workbook)
lastrow = Cells(Cells.Rows.Count, "B").End(xlUp).Row

If ActiveWorkbook.Name = "1.xls" Then
ActiveSheet.Rows("1:" & lastrow).Copy
Else
ActiveSheet.Rows("2:" & lastrow).Copy
End If
lastrowNew = Windows("1234.xls").ActiveSheet.Cells(Cells.Rows.C ount,
"B").End(xlUp).Row
Windows("1234.xls").ActiveSheet.Range("A" & lastrowNew).PasteSpecial
End Sub

--Modified the DoSomthing Sub.

--In Sub LoopThroughDirectory call DoSomething as below
DoSomething ActiveWorkbook, wbNew

Sub DoSomething(Book As Workbook, Book1 As Workbook)
Dim ws As Worksheet
Set ws = Book.Sheets(1)
lastrow = ws.Cells(Cells.Rows.Count, "B").End(xlUp).Row

If UCase(Book.Name) = "1.XLS" Then
ws.Rows("1:" & lastrow).Copy
Else
ws.Rows("2:" & lastrow).Copy
End If
lastrowNew = Book1.ActiveSheet.Cells(Cells.Rows.Count, _
"B").End(xlUp).Row
Book1.ActiveSheet.Range("A" & lastrowNew).PasteSpecial
Application.CutCopyMode = False
End Sub

If this post helps click Yes
---------------
Jacob Skaria


"Max" wrote:

Many thanks, Sam. Tested using your revision on the sub and it works fine in
picking it up from the dialog, and proceeding from there.

Could I have your help here on the last bit, that stacking part carried out
by Mike's
Sub DoSomething(Book As Workbook). I've pasted below the entire routine
which I just tested. Somehow the stacking sub misses capturing 2 lines, which
I checked were the last data lines in 1.xls and 2.xls. For info, my test
source 3.xls had zero data lines (it had only the row1 col headers). Thanks

-------------------------
Sub LoopThroughDirectory()

Application.DisplayAlerts = False

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Show
myPath = fd.SelectedItems(1) & "\"

Dim wbNew As Workbook
Set wbNew = Workbooks.Add()
wbNew.SaveAs Filename:=myPath & "1234.xls"
For x = 1 To 4
Workbooks.Open Filename:=myPath & x & ".xls"
'Here is the line that calls the macro below, passing the workbook to it
DoSomething ActiveWorkbook
ActiveWorkbook.Close savechanges:=False
Next
Application.DisplayAlerts = True
End Sub

Sub DoSomething(Book As Workbook)
lastrow = Cells(Cells.Rows.Count, "B").End(xlUp).Row

If ActiveWorkbook.Name = "1.xls" Then
ActiveSheet.Rows("1:" & lastrow).Copy
Else
ActiveSheet.Rows("2:" & lastrow).Copy
End If
lastrowNew = Windows("1234.xls").ActiveSheet.Cells(Cells.Rows.C ount,
"B").End(xlUp).Row
Windows("1234.xls").ActiveSheet.Range("A" & lastrowNew).PasteSpecial
End Sub

Jacob, many thanks. Need to test this at the office tomorrow.
Will feedback further here promptly. cheers.

Jacob, The 2 missed out lines are still there I'm afraid. Pasted below is the
entire routine which I tested. I have re-checked that the 2 missed out lines
were, as before, the last data lines in 1.xls and 2.xls. My test source 3.xls
had zero data lines (it had only the row1 col headers). Grateful for any
further help to resolve this. Thanks

------------------------
Sub LoopThroughDirectory()

Application.DisplayAlerts = False

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Show
myPath = fd.SelectedItems(1) & "\"

Dim wbNew As Workbook
Set wbNew = Workbooks.Add()
wbNew.SaveAs Filename:=myPath & "1234.xls"
For x = 1 To 4
Workbooks.Open Filename:=myPath & x & ".xls"
'Here is the line that calls the macro below, passing the workbook to it
'DoSomething ActiveWorkbook
DoSomething ActiveWorkbook, wbNew
ActiveWorkbook.Close savechanges:=False
Next
Application.DisplayAlerts = True
End Sub

Sub DoSomething(Book As Workbook, Book1 As Workbook)
Dim ws As Worksheet
Set ws = Book.Sheets(1)
lastrow = ws.Cells(Cells.Rows.Count, "B").End(xlUp).Row

If UCase(Book.Name) = "1.XLS" Then
ws.Rows("1:" & lastrow).Copy
Else
ws.Rows("2:" & lastrow).Copy
End If
lastrowNew = Book1.ActiveSheet.Cells(Cells.Rows.Count, _
"B").End(xlUp).Row
Book1.ActiveSheet.Range("A" & lastrowNew).PasteSpecial
Application.CutCopyMode = False
End Sub

Missed to mention +1 ...Try the below...

Sub DoSomething(Book As Workbook, Book1 As Workbook)
Dim ws As Worksheet
Set ws = Book.Sheets(1)
lastrow = ws.Cells(Cells.Rows.Count, "B").End(xlUp).Row
If UCase(Book.Name) = "1.XLS" Then
ws.Rows("1:" & lastrow).Copy
Else
ws.Rows("2:" & lastrow).Copy
End If
lastrowNew = Book1.ActiveSheet.Cells(Cells.Rows.Count, _
"B").End(xlUp).Row
Book1.ActiveSheet.Range("A" & lastrowNew+1).PasteSpecial
Application.CutCopyMode = False
End Sub

If this post helps click Yes
---------------
Jacob Skaria


"Max" wrote:

Jacob, The 2 missed out lines are still there I'm afraid. Pasted below is the
entire routine which I tested. I have re-checked that the 2 missed out lines
were, as before, the last data lines in 1.xls and 2.xls. My test source 3.xls
had zero data lines (it had only the row1 col headers). Grateful for any
further help to resolve this. Thanks

------------------------
Sub LoopThroughDirectory()

Application.DisplayAlerts = False

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Show
myPath = fd.SelectedItems(1) & "\"

Dim wbNew As Workbook
Set wbNew = Workbooks.Add()
wbNew.SaveAs Filename:=myPath & "1234.xls"
For x = 1 To 4
Workbooks.Open Filename:=myPath & x & ".xls"
'Here is the line that calls the macro below, passing the workbook to it
'DoSomething ActiveWorkbook
DoSomething ActiveWorkbook, wbNew
ActiveWorkbook.Close savechanges:=False
Next
Application.DisplayAlerts = True
End Sub

Sub DoSomething(Book As Workbook, Book1 As Workbook)
Dim ws As Worksheet
Set ws = Book.Sheets(1)
lastrow = ws.Cells(Cells.Rows.Count, "B").End(xlUp).Row

If UCase(Book.Name) = "1.XLS" Then
ws.Rows("1:" & lastrow).Copy
Else
ws.Rows("2:" & lastrow).Copy
End If
lastrowNew = Book1.ActiveSheet.Cells(Cells.Rows.Count, _
"B").End(xlUp).Row
Book1.ActiveSheet.Range("A" & lastrowNew).PasteSpecial
Application.CutCopyMode = False
End Sub

Tested your revision, Jacob. As-is, what happens now is that in the stacked
output sheet, the header row gets pushed down to row2, and another header row
(from 3.xls, which has zero data) gets written into the stack which is not
supposed to happen. A fine check reveals that all data lines are there
(including the 2 missed out earlier) so data-wise, its ok. Could something be
done to get the header row back to row1, and for the sub to be able to handle
any zero data line cases (like 3.xls in this instance) without stacking the
header row in-between? Thanks

Try this version...and feedback

Sub DoSomething(Book As Workbook, Book1 As Workbook)
Dim ws As Worksheet, lastRow As Long, lastrowNew As Long
Set ws = Book.Sheets(1)
lastRow = ws.Cells(Cells.Rows.Count, "B").End(xlUp).Row
If UCase(Book.Name) = "1.XLS" Then
ws.Rows("1:" & lastRow).Copy
Book1.ActiveSheet.Range("A1").PasteSpecial
Else
If lastRow 1 Then
ws.Rows("2:" & lastRow).Copy
lastrowNew = Book1.ActiveSheet.Cells(Cells.Rows.Count, _
"B").End(xlUp).Row
Book1.ActiveSheet.Range("A" & lastrowNew + 1).PasteSpecial
End If
End If
Application.CutCopyMode = False
End Sub

If this post helps click Yes
---------------
Jacob Skaria


"Max" wrote:

Tested your revision, Jacob. As-is, what happens now is that in the stacked
output sheet, the header row gets pushed down to row2, and another header row
(from 3.xls, which has zero data) gets written into the stack which is not
supposed to happen. A fine check reveals that all data lines are there
(including the 2 missed out earlier) so data-wise, its ok. Could something be
done to get the header row back to row1, and for the sub to be able to handle
any zero data line cases (like 3.xls in this instance) without stacking the
header row in-between? Thanks

Just tested, that last revision nails it well, Jacob.
Many thanks for your help.