Sub to stack data n paste unique order ID lines

[Max]

Looking for help for a sub to do this: Stack up identical structure data from
4 source files, then paste unique lines (based on "order id" col) into a new
sheet

I would run this sub from Personal.xls,
navigate to a folder, where there would be 4 files:
1.xls
2.xls
3.xls
4.xls

Each file contains only 1 sheet with data (sheetnames may vary from day to
day and are to be disregarded). The data in all 4 files are identical in
structure, with col headers in row 1, data from row2 down. Col B is used to
determine data extent.

The sub will create a new book, name it as simply: 1234.xls, save it into
the same folder as the source files, then copy n paste (stack up) entire data
rows from each of the 4 source files into Sheet1 (with col headers pasted
into row 1)

Then the sub will carve out uniques based on the "Order ID" col header, and
paste these unique lines into a new sheet, naming this new sheet as:
UniqueOrderIDs

 

[Mike H]

Hi,

Here are 2 subs. The first creates your new workbook and opens each of the
four workbooks in turn. It then calls the second sub.

The second sub does the copying and pasting from 1.xls etc to 1234.xls.

Note i included no error checking so if 1234.xls already exists you get an
error, I have assumed a single sheet in each of the 4 workbooks opened.

You will need to set MyPath to the correct path

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

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.Count,
"B").End(xlUp).Row
Windows("1234.xls").ActiveSheet.Range("A" & lastrowNew).PasteSpecial
End Sub


Mike

 

[Max]

Thanks, Mike. Will be testing it out shortly "live" in the office, and
feedback further here

Just 2 quick clarifications:
a. > You will need to set MyPath to the correct path
but I need to make this as a variable for the sub/Excel to pick up, that's
why I mentioned I'd navigate to the folder upon running the sub. The path
will be different everyday

b. > .. carve out uniques based on the "Order ID" col header, and
How could the above functionality be done by the sub? There will be only one
col with the header: Order ID within the stacked data. Its position may vary,
hence the sub needs to locate the col via the header text, then do the
necessary

 

[Max]

Will be testing it out shortly "live" in the office, and feedback further
here

Tested, the sub misses capturing 2 lines, which I checked were the last data
lines in 1.xls and 2.xls. For info, my source 3.xls had zero data lines (it
had only the row1 col headers).