Add 1 row from Multiple Files into a single spreadsheet

[JRott]

I have a group of files on a network drive.

Directory is S:\Railserve\Availability

The Excel files all start with Availability. After Availability is the date the file was created, followed by .xlsx So example, Availability041012.xlsx

The file has multiple worksheets, but work sheet names are the same in each file. I need data from the "Car Summary By Product Line"

The data from each sheet that I would like to get from each sheet starts in A4 through I4. There are forumlas in several of the cells so would need to be a Paste Special Values type copy.

So code/macro would do this:

Copy row A4:I4 from File Availability041012.xlsx, Worksheet "Car Summary By Product Line" to a row in the Master file

Then repeat for the next file Availability041212.xlsx (this data isn't typically generated on weekends so won't be a consistent date + 1) copied to the next row down on the Master file. This would allow me to chart data for car counts from day to day. It would be really cool to have the file date in Column J so I could chart by date and show a trend, but I know beggers can't be choosers.

Thanks, Jeff

I have roughly 200 days with multipule product lines so copying and pasting each one wouldn't be feesible.

[JBeaucaire]

This should do it:

Option Explicit

Sub CollateDatedData()
Dim fPATH As String, fNAME As String, NR As Long, fDate As String
Dim wb As Workbook, ws As Worksheet, wsMaster As Worksheet

On Error GoTo ErrorExit
Application.ScreenUpdating = False                  'speed up macro, turn off screen flicker
                                                    'make sure master has titles in row1 already
Set wsMaster = ThisWorkbook.Sheets("Master")        'edit to name of sheet for report
fPATH = "S:\Railserve\Availability\"                'remember the final \ in this string

If MsgBox("Clear the current data on the master?", vbYesNo, "Reset Master") = vbYes Then
    wsMaster.UsedRange.Offset(1).Clear              'option to clear data, keep titles
    NR = 2                                          'start entering data at row 2
Else
    NR = wsMaster.Range("A" & Rows.Count).End(xlUp).Row + 1     'add data to existing data, next row
End If
    
fNAME = Dir(fPATH & "Availability*.xlsx")           'get the first filename from the fPATH

Do While Len(fNAME) > 0                             'process each file one at at time
    fDate = Replace(Replace(fNAME, ".xlsx", ""), "Availability", "")
    fDate = Left(fDate, 2) & "/" & Mid(fDate, 3, 2) & "/" & Mid(fDate, 5, 2)    'create date string
    Set wb = Workbooks.Open(fPATH & fNAME)                                      'open the found file
    wb.Sheets("Car Summary By Product Line").Range("A4:I4").Copy                'copy the date
    wsMaster.Range("A" & NR).PasteSpecial xlPasteValues                         'paste values only
    wsMaster.Range("A" & NR).PasteSpecial xlPasteFormats                        'correct formatting
    wsMaster.Range("J" & NR).Value = fDate                                      'add date to column J
    wb.Close False                                  'closed the found file
    
    NR = NR + 1                                     'increment the next row for data
    fNAME = Dir                                     'get the next filename from FPATH
Loop                                                'repeat til no more filenames

ErrorExit:
Application.ScreenUpdating = True                   'return to normal speed, update screen
End Sub

[JRott]

Thanks Jerry. The macro works to the point of clering the data and then nothing happens. I don't even get an error stating a macro failure issue. What can I provide to help debug this. Thanks Jeff

[JBeaucaire]

Remove this code:

On Error Goto ErrorExit
Application.ScreenUpdating = False                  'speed up macro, turn off screen flicker

Then try it again. When it errors, DEBUG. Use your mouse over all the variables on the highlighted code to see what the current values are. One of them has an error.

[JRott]

Jerry, Ok I took out the code and no errors poped up, but no code in the file I am using to collect it. I ended up calling the file to add the data to Collectdata.xlsm and the sheet Total Cars. I also changed the range to collect. I added the sheet name as the code said. I also tried to change ThisWorkbook to the file name, yet it errored out and I couldn't get it to work so I went back to ThisWorkbook. Below is the code the way I have it with no errors looks like this. But no information is being collected in the Collectdata.xlsm file. The data i cut in does clear though Sorry to be a pain, but I really need to get this working. I really appreciate your help and paitence. Jeff

Option Explicit

Sub CollateDatedData()
Dim fPATH As String, fNAME As String, NR As Long, fDate As String
Dim wb As Workbook, ws As Worksheet, wsMaster As Worksheet

Application.ScreenUpdating = False                  'speed up macro, turn off screen flicker
                                                    'make sure master has titles in row1 already
Set wsMaster = ThisWorkbook.Sheets("Total Cars")    'edit to name of sheet for report
fPATH = "S:\Railserve\Availability\"                'remember the final \ in this string

If MsgBox("Clear the current data on the master?", vbYesNo, "Reset Master") = vbYes Then
    wsMaster.UsedRange.Offset(1).Clear              'option to clear data, keep titles
    NR = 2                                          'start entering data at row 2
Else                                                'add data to existing data, next row
    NR = wsMaster.Range("A" & Rows.Count).End(xlUp).Row + 1
End If

fNAME = Dir(fPATH & "Availability*.xlsx")           'get the first filename from the fPATH

Do While Len(fNAME) > 0                             'process each file one at at time
    fDate = Replace(Replace(fNAME, ".xlsx", ""), "Availability", "")
    fDate = Left(fDate, 2) & "/" & Mid(fDate, 3, 2) & "/" & Mid(fDate, 5, 2) 'create date string
    Set wb = Workbooks.Open(fPATH & fNAME)                                   'open the found file
    wb.Sheets("Car Summary By Product Line").Range("A27:G27").Copy           'copy the date
    wsMaster.Range("A" & NR).PasteSpecial xlPasteValues                      'paste values only
    wsMaster.Range("A" & NR).PasteSpecial xlPasteFormats                     'correct formatting
    wsMaster.Range("J" & NR).Value = fDate                                   'add date to column J
    wb.Close False                                                           'closed the found file

    NR = NR + 1                                     'increment the next row for data
    fNAME = Dir                                     'get the next filename from FPATH
Loop                                                'repeat til no more filenames

End Sub

[arlu1201]

JRott,

Welcome to the forum.

I have added code tags to your post. As per forum rule 3, you need to use them whenever you put any code in your post. Please add them in future. If you need more information on how to use them, check my signature below this post.

[JBeaucaire]

Then perhpas it's failing here:

     fNAME = Dir(fPATH & "Availability*.xlsx")

Are you sure the files in the fPATH folder start with that word? If there are no other files in the fPATH other than the files to be imported, then perhaps:

     fNAME = Dir(fPATH & "*.xls*")

[JRott]

Ok I get an error saying the file under

 fPATH = S:\Railserve\Availability\

Am I supposed to have a file name there I have tried the first file name in the list, *.*, Availability*.xlsx, etc nothing works, but when error occurs, debugger is highlighting

  Set wb = Workbooks.Open(fPATH & fNAME)

Not sure if I am doing something wrong.

[JBeaucaire]

Where are the quotes around the fPATH string? My version has quotes around the string, yours doesn't.

      fPATH = "S:\Railserve\Availability\"

[JRott]

Sorry Jerry, In my code I do have the quotes I just typed it to ask my question. But in the macro I have the quotes. I am new to all this forum stuff and VBA. I have never been formally trained. Thanks for being paitent with me and letting me know when I make errors.

I know that your code will work, I am just messing something up. As I step through the code, the steps execute, The highlighter gets to,

Do While Len(fNAME) > 0

Then it jumps to

ErrorExit:

Even without the error exit line in there it just ends the run. Something I have done seems to be pushing it to go to error/end. I tried changing the number after the greather than sign, but that didn't help either. If you go back to my post from 12/6 at 4:10 pm that is how my code stands today and when I step through, that is when it jumps to the end. I appreciate your help and understand if you are done fooling with my silly request. I do appreciate your help though!. Thanks, Jeff

[JBeaucaire]

Then problem lies here:

fNAME = Dir(fPATH & "Availability*.xlsx")           'get the first filename from the fPATH

This line of code tries to find a file called availability*.xlsx" in the fPATH folder. It puts that filename into the fNAME variable.

This line of code:

Do While Len(fNAME) > 0

...simply means, "only DO the following codes if there is a filename in the fNAME variable that is more then 0 characters long.

It appears the fPATH is declared inaccurately (folder not there, spelled slightly differently, you forgot the final \ in the string...) or there is NO file in that folder that matches that wild card string.

[JRott]

Jerry, Thank you. I moved the folder from my network drive to a local drive and the Macro performed perfect. I really appreciate all your help with this this will really assist me in getting the data I need.

[JBeaucaire]

Glad to help.

If that takes care of your original query, please select Thread Tools from the menu above and mark the thread as solved. Thanks.