Macro to build a database

[EduPAz]

Hi guys,

Can someone please can help me with this problem? I know it's a macro but I don't know how to start:


I have a folder called Data in this extension C:\Documents
There are 12 sub-folder (Jan, Feb, Mar,.., Dec) in the folder Data.
Every sub-folder (Jan, Feb, Mar,.., Dec) has 30 files (a1, a2, a3, a4, …a30)

I need to build a database (one tab) with the information from all the 30 files of every sub folder. In other words, I need to put the information of every single file (30*12) in one file.

Thanks in advance!!!

Edu

 

[pbornemeier]

Do you want to copy each row of each worksheet in each of the 360 files to the same worksheet in a summary workbook?
Is the data layout the same on each worksheet of each workbook?
Are there headers on each worksheet? Do you want the headers copied too?

Do you want to copy each worksheet in each of the 360 files to the same summary workbook?

Once the data is in a single workbook (in whatever form) do you care what data came from what workbook/worksheet/row?
Does the order that the worksheets/rows are added to the summary workbook make any difference?
What is the extension of the data workbooks? (.xls, .xlsx, .xlsm, .xlsb, .txt) ?

 

[EduPAz]

- Yes, I want to copy each row of each worksheet in each of the 360 files to the same worksheet in a summary workbook
- Yes, the data layout is the same on each worksheet of each workbook
- Yes, there are headers on each worksheet. I would like to have only the data (to exclude the headers). However, if that is too difficult, I am satisfied with having the headers copied

- Yes, I would like to copy each worksheet in each of the 360 files to the same summary workbook

- No, I don't care what data came from what workbook/worksheet/row
- No, the the order that the worksheets/rows are added to the summary workbook doesn't make any difference
- The extension of the data workbooks is xlsx

 

[dcardno]

How many rows are used in each of the a1, a2, etc workbooks? Are there a31 workbooks for some months and not others (ie, May v September)?
Is this something you will repeat, or is it a one-off?
For a one-off you might use the "Indirect" function, and build the required reference strings through a formula. After the data is available you can copy the data onto itself as values (the indirect function will really slow things down...)

 

[dcardno]

Scratch that - sorry, I had forgotten that Indirect requires the other s/sheet to be open - I used it for in-workbook referencing and forgot that issue.

 

[pbornemeier]

Option Explicit

Sub Compile360Data()
    
    'Put this code in a standard module in a new workbook.
    
    'This code will not change any source data but the first and second sheets in
    'the workbook containing it will be cleared each time the code is run
    
    'Requirements:
    ' I have a folder called Data in this extension C:\Documents
    ' There are 12 sub-folder (Jan, Feb, Mar,.., Dec) in the folder Data.
    ' Every sub-folder (Jan, Feb, Mar,.., Dec) has 30 files (a1, a2, a3, a4, …a30)
    '
    ' I need to build a database (one tab) with the information from all the 30
    ' files of every sub folder. In other words, I need to put the information
    ' of every single file (30*12) in one file.
    
    Dim sFileBasePath As String
    Dim sFilePathNameExt As String
    Dim sFileNameExt As String
    Dim lMonthIndex As Long
    Dim lFileIndex As Long
    Dim wks As Worksheet
    Dim lDataWriteRow As Long
    Dim lCopyOffsetRow As Long
    Dim lReportWriteRow As Long
    Dim lDataRowCount As Long
    
    'Clear data from this workbook
    With ThisWorkbook
        .Worksheets(1).Cells.Clear
        .Worksheets(2).Cells.Clear
        .Worksheets(2).Range("A1").Resize(1, 2).Value = Array("Data Rows", "File Path Name Ext")
    End With
    
    sFileBasePath = "C:\Documents\Data"    'Trailing slash needed
    
    lDataWriteRow = Cells(Rows.Count, 1).End(xlUp).Row
    lCopyOffsetRow = 0
    For lMonthIndex = 1 To 12
        For lFileIndex = 1 To 30
            sFilePathNameExt = sFileBasePath & Format(DateSerial(1, lMonthIndex, 1), "mmm") & "" & "a" & lFileIndex & ".xlsx"
            Workbooks.Open Filename:=sFilePathNameExt, ReadOnly:=True
            sFileNameExt = ActiveWorkbook.Name
            For Each wks In Workbooks(sFileNameExt).Worksheets
                'Convert to Values - uncomment next 2 rows if any formulas in data cells
                ActiveSheet.UsedRange.Cells.Copy
                ActiveSheet.UsedRange.Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
                'End Convert to Values
                lDataRowCount = wks.Range("A1").CurrentRegion.Rows.Count - 1
            
                wks.Range("A1").CurrentRegion.Offset(lCopyOffsetRow, 0).Copy _
                    Destination:=ThisWorkbook.Sheets(1).Cells(lDataWriteRow, 1)
                With ThisWorkbook.Sheets(1)
                    lDataWriteRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                    lCopyOffsetRow = 1
                End With
                With ThisWorkbook.Sheets(2)
                    lReportWriteRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                    .Cells(lReportWriteRow, 1).Value = lDataRowCount
                    .Cells(lReportWriteRow, 2).Value = sFilePathNameExt & "  " & wks.Name
                End With
            Next
            Workbooks(sFileNameExt).Close SaveChanges:=False
        Next
    Next
    
End Sub

 

[EduPAz]

Hi Phil,

I'm getting this error:

Run-time error '1004':

Sorry, we couldn't find C:C:\Users\aaa\Desktop\Timesheets\test3\Jana1.xlsx. Is it possible it was moved, renamed or deleted?

In this part of your code, I put my file location:
sFileBasePath = "C:\Users\aaa\Desktop\Timesheets\test3" 'Trailing slash needed

For some reason, after test3\, the code is adding Jana1. Do you know why this could be?

 

[pbornemeier]

Add a slash to each of these lines where indicated:

sFileBasePath = "C:\Users\aaa\Desktop\Timesheets\test3[COLOR="#FF0000"]\[/COLOR]" 'Trailing slash needed
sFilePathNameExt = sFileBasePath & Format(DateSerial(1, lMonthIndex, 1), "mmm") & "[COLOR="#FF0000"]\[/COLOR]" & "a" & lFileIndex & ".xlsx"

I had a trailing slash in the path I tested (and later deleted that line), I failed to put a trailing slash in the code I posted. Add one at the end of your basepath.

I lost the slash between the Month abbr and the aX series when I posted the code without first adding code tags. The parser removed it.

This is generating the 3-character month abbr.
This is generating the a1...a30 sequence.

[COLOR="#006400"]Format(DateSerial(1, lMonthIndex, 1), "mmm")[/COLOR] & "\" & [COLOR="#0000FF"]"a" & lFileIndex[/COLOR] & ".xlsx"

The first time through the For...Next loops this code will produce: Jan\a1.xlsx
then Jan\a2.xlsx

I can't figure out how C:C: could appear. I hope you made a typo when entering it.

 

[EduPAz]

Thanks Phil. Yes, it was a typo.
I have the password that allow me to unblock the protected files.
How could I modify the code so instead of creating a copy when there's a protected file, the code will insert the password when there's a protected file?

Thanks!

Edu

 

[pbornemeier]

What kind of protected file? (in order of tightening security)

Need Password to select cells (possible at a Sheet Protect level)
Need Password to Open
Need Password to Modify

Is the password the same for all files? (I believe so from your phrasing, but need to be sure)

Do you want to include the password in the code? or Enter it each time the program finds a protected file? or Enter it the first time it finds a protected file and attempt to use the same password for any subsequent protected files?