• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 245
  • Last Modified:

Macro needed

Hi Experts!

I am in need of some assistance with this challenge.  We receive on a daily basis many Excel files that come in in the same format.  What we want to do is the following:

1--Take each of the files and add the "posted" date on the end of each row.  I've attached an example so you can see exactly what we are looking for.  The date is always located in A3.  But it is "just a date" there is some text with it.  

2--We want to take all the files in the daily folder "combine" and have the data in the sheet of each workbook labeled "PartnerApprovedDailyPostedSales".  (this is always the name) combine into 1 new workbook on a single tab stacked on top of one another.  Just as if you cut and pasted each of the workbooks individually into one worksheet.   The data always starts in A1 on row 6 but in varies in how many rows each workbook will have.  

Any help would be very much appreciated.  

Spudmcc
EXAMPLE.XLS
0
spudmcc
Asked:
spudmcc
  • 6
  • 3
1 Solution
 
xtermieCommented:
Hey there...for the first part, I have written a short macro that will copy your BEFORE worksheet, rename it to NEW, detect the date in A3 and then fill in any line that has data, in its respective cell in column I.
Sub AddDateRow()
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim mystr As String
Dim mydate As Date
Dim mycell As Range
Dim c As Range

orinsheet = "Before"    'Change the name to the origin sheet
destsheet = "New"       ' Change the name to destination sheet
Set ws = Application.ActiveWorkbook.Sheets(orinsheet)
mystr = ws.Range("A3").Value
mystr = Right(mystr, Len(mystr) - 10)
mydate = mystr
ws.Activate
Application.ActiveSheet.Copy After:=Worksheets(orinsheet)
ActiveSheet.Select
ActiveSheet.Name = destsheet
Set ws2 = ActiveSheet
'Insert date at end
For i = 6 To ws2.UsedRange.Rows.Count
    lc = "I" & i
    Set mycell = ws2.Range(lc)
    mycell.Select
    mycell.Value = mydate
Next
End Sub

Open in new window

Not sure what you mean by the second part.  In addition, your Before and After worksheets had differences in data - for example in the Product Name and the TITLE of the worksheet...any rule there?
0
 
xtermieCommented:
For the second part, do you mean that
1.  You have all similar Excel files in a folder, ie C:\MySales
2.  All Excel files have a worksheet named PartnerApprovedDailyPostedSales
3.  You want to create a NEW file where you want to copy the contents of all PartnerApprovedDailyPostedSales worksheets into a single worksheet.

Correct?
0
 
xtermieCommented:
Can I assume that all data begins from ROW 6? and Row 6 and that the header in Row 5 is needed only once?
0
Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

 
spudmccAuthor Commented:
We will have maybe 10 of these workbooks in a single folder "combine".  What we want to do is create a new workbook and merge all of the other workbooks in the folder taking the data from each (from row 6 down) and put it in 1 single worksheet but stack the data.  In other words, take workbook 1 data and put it on the top of the sheet.  Take workbook 2 data and put it under the workbook 2 data.  Do this for all the workbooks in the folder and combine into the new workbook with the single sheet.  

The objective is to have one worksheet with all the data from all the workbooks in one book.  

Hope that helps.  

A
0
 
spudmccAuthor Commented:
Also, could we possible take your solution from above and configure it so that it would work after all of the workbooks are combined.  In other words instead of assigning it to just one worksheet name at a time have it do your script for all worksheets.  

A
0
 
xtermieCommented:
Hey there..given that the dates will be different, it is probably better to first run the 1st macro for the date first for all excel files and then combine
0
 
xtermieCommented:
Now in order to combine the worksheets, assuming they are all in a specific path (ie c:\combine) and all sheets you want to combine have the same name (ie New) then something like this would work:
Sub Combine1()
Dim wb As Workbook, ws As Worksheet
Dim fso As Object, f As Object
Dim FilePath As String
'Get data folder.
FilePath = "C:\combine"  'you can replace with the actual path the excel files are in
Set fso = CreateObject("scripting.filesystemobject")
For Each f In fso.getfolder(FilePath).Files
    If f.Type Like "*Excel*" Then
        Set wb = Workbooks.Open(f.Path)
        Call Combine2
        wb.Close True
    End If
Next f
End Sub

Open in new window

with the actual work being done by the Combine2 Macro.
0
 
xtermieCommented:
Well here goes
(1) Create a c:\combine folder
(2) have all excels that you have run the 1st macro on in the above folder
(3) create a FINAL subfolder in the c:\combine folder
Run this macro from the PERSONAL Macro book
Sub Combine1()
Dim wb As Workbook, ws As Worksheet
Dim wb2 As Workbook, ms As Worksheet
Dim myrng As Range
Dim fso As Object, f As Object
Dim FilePath As String
'Create new file for combining data
Workbooks.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "combine"
    Range("A1").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    ChDir "C:\combine\final"
    ActiveWorkbook.SaveAs Filename:="C:\combine\final\FinalCombine.xlsx", FileFormat _
        :=xlOpenXMLWorkbook, CreateBackup:=False
Set wb2 = ActiveWorkbook
'Get data folder.
FilePath = "C:\combine"  'you can replace with the actual path the excel files are in
mysh = "New" 'specify sheet name
Set fso = CreateObject("scripting.filesystemobject")
fl = 0
For Each f In fso.getfolder(FilePath).Files
    If f.Type Like "*Excel*" Then
        Set wb = Workbooks.Open(f.Path)
        x = (wb2.Sheets("combine").UsedRange.Rows.Count) + 1
        MsgBox x
        If fl = 0 Then myarea = "A" & x Else myarea = "A" & (x + 1)
        MsgBox myarea
        wb2.Activate
        Set ms = wb2.Sheets("combine")
        ms.Range(myarea).Select
        wb.Activate
        x = wb.Sheets(mysh).UsedRange.Rows.Count
        myarea = "A6" & ":" & "I" & x
        Set myrng = wb.Sheets(mysh).Range(myarea)
        myrng.Select
        Selection.Copy
        wb2.Activate
        ms.Paste
        wb2.Save
        wb.Close True
    End If
wb2.Save
fl = 1
Next f
wb2.Close
End Sub

Open in new window

All files should be combined into a new file named FinalCombine.xlsx that will be created in the C:\combine\final folder
0
 
spudmccAuthor Commented:
Thank you so much for your time, patience and talent.  Your solution will save us many hours and bandwidth that we just don't have now.  

Thanks again!

A
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 6
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now