get information from different files for master sheet

[eshtica]

Hello,

- I have the following folder/file structure:

MP1
CT
CTfile1.csv
CTfile2.csv
CV
CVfile1.csv
CVfile2.csv
FT
FTfile1.csv
FTfile2.csv

...etc - it keeps on going for more subfolders.



- Every subfolder has 2 different .csv files.

- Every file has the same structure. Relevant info:
. column B - time string
. column C - value

- The files are automatically genarated and report lots of single events (evaluated in Column C) that occurr in a specific time (dd/mm/yyyy hh:mm:ss specified in Column B)

- All files have the same number of lines.

- Line 2 in fileX refers to the same time as Line 2 in fileY; the same for all lines.




What I need is a Macro in a file "Master.xls" placed in folder MP1 to automatically:

1. open each file in the subfolders
2. copy the time string (column B) for A2 down - only needed for the first file
3. copy the relevant info (column C) - in every file
4. close all files



Result: I have a "Master" file with the relevant info of all the others, preceeded by a time string from where I can work (pivot table, graph, etc.). The files can have from 5.000 to 30.000 lines, depending on the day.



P.S. The MP1 folder path should not be locked, I should be able to move this folder around, but its substructure will always remain the same.



Thanks in advance.

 

[pbornemeier]

This code seems to do what you asked for. From your description, MP1 directory is at the same level as the directories that contain the .csv files. If this is not the case, the code must be modified.

WARNING: When this code is run, the all cells on the active sheet of the master.xls file will be erased and new data placed in it.
Filenames are place in row 1 above data from that file.

Sub CollectDataFromFilesInSubDirsToArray()
    'Original Recursive File List code (very cool) from
    'http://www.mrexcel.com/forum/showthread.php?t=35674
 
    Dim lFilesCount As Long
    Dim aryFiles()
    Dim lX As Long
    Dim sFilePathAndName As String
    Dim sFileName As String
    Dim iDestinationColumn As Integer
    Dim lLastDataRow As Long
    Dim lFileCount As Long
    Dim strDir As String
 
    On Error GoTo Error_Handler
 
    Application.ScreenUpdating = False
    'Start in directory above the one this program is in
    strDir = ThisWorkbook.Path
    strDir = Left(strDir, InStrRev(strDir, "\"))
 
    With Application.FileSearch
        .FileType = msoFileTypeAllFiles
        .LookIn = strDir
        .SearchSubFolders = True 'or True, depends on you
        If .Execute() > 0 Then
            ReDim aryFiles(.FoundFiles.Count)
            aryFiles = Array(.FoundFiles)
            'For lFilesCount = 1 To .FoundFiles.Count
                'Cells(lFilesCount, 1).Value = .FoundFiles(lFilesCount)
            'Next lFilesCount
        End If
    End With
    'FilePath/Name is stored in
    'aryFiles(0).Item(1) 'through
    'aryFiles(0).Item(aryFiles(0).Count)
 
    lFileCount = aryFiles(0).Count
 
    If lFileCount > 0 Then
        ThisWorkbook.ActiveSheet.Cells.Clear
    End If
 
    For lX = 1 To lFileCount
        Application.StatusBar = "Processing file " & lX & " of " & lFileCount
        sFilePathAndName = aryFiles(0).Item(lX)
        sFileName = Right(sFilePathAndName, Len(sFilePathAndName) - InStrRev(sFilePathAndName, "\"))
 
        If InStr(sFileName, ".csv") > 0 Then 'Only work with .csv files (may need to add other restrictions)
 
            Workbooks.Open FileName:=sFilePathAndName, _
                Notify:=False, UpdateLinks:=False, ReadOnly:=True
            lLastDataRow = Cells(Rows.Count, 2).End(xlUp).Row
 
            If lX = 1 Then
                'Copy column B
                iDestinationColumn = 1
                ActiveSheet.Range(Cells(2, 2), Cells(lLastDataRow, 2)).Copy _
                    Destination:=ThisWorkbook.ActiveSheet.Range("A2")
                ThisWorkbook.Worksheets(1).Cells(1, 1) = "Time"
            End If
 
            'Copy Column C
            iDestinationColumn = iDestinationColumn + 1
            ActiveSheet.Range(Cells(2, 3), Cells(lLastDataRow, 3)).Copy _
                Destination:=ThisWorkbook.ActiveSheet.Cells(2, iDestinationColumn)
            ThisWorkbook.Worksheets(1).Cells(1, iDestinationColumn) = sFileName
 
            ActiveWorkbook.Saved = True 'shouldn't be needed
            ActiveWorkbook.Close
 
        End If
    Next
 
    GoTo End_Sub
 
Error_Handler:
    Debug.Print Err.Number
    Debug.Print Err.Description
    MsgBox "Error" & vbCrLf & vbCrLf & Err.Number & vbCrLf & Err.Description
 
End_Sub:
    Application.ScreenUpdating = True
    Application.StatusBar = False
 
    MsgBox "Processing Complete.  Imported " & iDestinationColumn - 1 & " files."
End Sub

 

[eshtica]

Helo Phil,

Thanks a lot for your quick reply and for the work done.

Actually all report folders are inside MP1 folder - I indented these folders but they did not appear as I thought they would.
Nevertheless I created a MP1 folder at the same level of all the other report files to try this code.

As I am just clueless in VBA code I just copied your code directly to create a macro.

Then, when I ran it in master.xls the result was not what I expected; I only got data in row 1 with all the filenames, no time column neither data from those files below.

What is missing here?


Thanks again.

 

[pbornemeier]

I'll adjust the code to expect all data files are under the MP1 directory.
MP1
--CT
----CTfile1.csv
----CTfile2.csv
--CV
----CVfile1.csv
----CVfile2.csv
--FT
----FTfile1.csv
----FTfile2.csv

Please use Excel Jeanie (see link in my sig) to post the first few rows/columns of one of your data files (A1:C5).
Note: With Excel 2003 and earlier, you will be limited to 255 data files. Is there some data in column A? When I tried to make a .csv file with your specs, and column A was blank, column A was not present when I opened the data file again, So I had to put dummy data in column A to hold B & C in place.

 

[eshtica]

I am in my work laptop now - not an admin - so I cannot install Jeanie here.

Example of data file:

------A--------------B--------------C
1--varName------timeString------varValue
2--CT001----30/12/2009 17:28-----353
3--CT001----30/12/2009 17:29-----352
4--CT001----30/12/2009 17:30-----354
5--CT001----30/12/2009 17:31-----357



The data in column A is always the same; it is the variant name, similar to the name of the .cvs file.


I have a top of 50 data files and they normally have less than 10.000 rows.

 

[pbornemeier]

I tested the code I originally posted/this code. For me it pulled/pulls data as you required. I am not sure why it did not work on your workbooks.

I modded the code to start with the folder the master.xls files is in and look for .csv files in and below that directory. I also added a few lines to make it operate a bit better.

For troubleshooting, I put in two blocks of three lines that will stop the code with the cells it is about to copy from the .csv files selected. Please look at your files to see what is being selected. If the correct data is not being selected, please let me know what is being selected.

A .csv file can only have a single sheet, so that cannot be the problem.
Do you have any hidden columns?

Phil

This code should be placed in a standard module in the Master.xls workbook

Option Explicit
Sub CollectDataFromFilesInSubDirsToArray()
    'Original Recursive File List code (very cool) from
    'http://www.mrexcel.com/forum/showthread.php?t=35674
 
    Dim lFilesCount As Long
    Dim aryFiles()
    Dim lX As Long
    Dim sFilePathAndName As String
    Dim sFileName As String
    Dim iDestinationColumn As Integer
    Dim lLastDataRow As Long
    Dim lFileCount As Long
    Dim strDir As String
 
    On Error GoTo Error_Handler
 
    Application.ScreenUpdating = False
 
    strDir = ThisWorkbook.Path 'Start search in the directory this program is in
 
    With Application.FileSearch
        .NewSearch 'Search criteria settings to defaults
        .FileName = "*.csv"
        .FileType = msoFileTypeAllFiles
        .LookIn = strDir
        .SearchSubFolders = True
        If .Execute() > 0 Then
            ReDim aryFiles(.FoundFiles.Count)
            aryFiles = Array(.FoundFiles)
        End If
    End With
    'FilePath/Name is stored in
    'aryFiles(0).Item(1) 'through
    'aryFiles(0).Item(aryFiles(0).Count)
 
    lFileCount = aryFiles(0).Count
 
    If lFileCount > 0 Then
        ThisWorkbook.ActiveSheet.Cells.Clear
    End If
 
    For lX = 1 To lFileCount
        Application.StatusBar = "Processing file " & lX & " of " & lFileCount
        sFilePathAndName = aryFiles(0).Item(lX)
        sFileName = Right(sFilePathAndName, Len(sFilePathAndName) - InStrRev(sFilePathAndName, "\"))
 
        If InStr(sFileName, ".csv") > 0 Then 'Only work with .csv files (may need to add other restrictions)
 
            Workbooks.Open FileName:=sFilePathAndName, _
                Notify:=False, UpdateLinks:=False, ReadOnly:=True
            lLastDataRow = Cells(Rows.Count, 2).End(xlUp).Row
 
            If lX = 1 Then
                'Copy column B
                iDestinationColumn = 1
 
                ActiveSheet.Range(Cells(2, 2), Cells(lLastDataRow, 2)).Select
                Stop ' see if the correct column B data is selected in first file
                'If it is you can delete the 3 lines in this codeblock
 
                ActiveSheet.Range(Cells(2, 2), Cells(lLastDataRow, 2)).Copy _
                    Destination:=ThisWorkbook.ActiveSheet.Range("A2")
                ThisWorkbook.Worksheets(1).Cells(1, 1) = "Time"
            End If
 
            'Copy Column C
            iDestinationColumn = iDestinationColumn + 1
 
            ActiveSheet.Range(Cells(2, 3), Cells(lLastDataRow, 3)).Select
            Stop ' see if the correct column C data is selected in each file
            'If it is you can delete the 3 lines in this codeblock
 
            ActiveSheet.Range(Cells(2, 3), Cells(lLastDataRow, 3)).Copy _
                Destination:=ThisWorkbook.ActiveSheet.Cells(2, iDestinationColumn)
            ThisWorkbook.Worksheets(1).Cells(1, iDestinationColumn) = _
                Left(sFileName, Len(sFileName) - 4)
 
            ActiveWorkbook.Saved = True 'shouldn't be needed for a .csv file, but ...
            ActiveWorkbook.Close
 
        End If
    Next
 
    Cells.Columns.AutoFit
 
    GoTo End_Sub
 
Error_Handler:
    Debug.Print Err.Number
    Debug.Print Err.Description
    MsgBox "Error" & vbCrLf & vbCrLf & Err.Number & vbCrLf & Err.Description
 
End_Sub:
    Application.ScreenUpdating = True
    Application.StatusBar = False
 
    MsgBox "Processing Complete.  Imported " & iDestinationColumn - 1 & " files."
End Sub

 

[eshtica]

Hello Phil,

Thanks again for your time and work.

I now see a problem. When I open a .cvs file its structure is like I wrote before; but when it is your code opening the .cvs file I see a ";" separated structure. All columns are now together in column A.


Example in A2:

CT001;"30/12/2009 17:28";353


Furthermore I now get a new piece of information that I do not know where it is comming from. In column B there are some new strange figures that do not appear anywhere in the original .cvs files.

Here is an example of a .cvs file as I see them:
http://www.4shared.com/file/197537277/416d9526/Pastes1CT_10.html


Can you try with this?



Thanks a lot.

 

[eshtica]

Maybe a text to columns ; separated needed here or a code line to chang the way excel is treating the .cvs files when opening them.

 

[pbornemeier]

The updated code will handle the format that you sent. I left the two temporary blocks of code in so you can verify the correct data is being selected. You can delete those two blocks of three lines once that is verified.

If for some reason the format of the import file changes, the code may not properly handle it.

When I double-click on the .csv file you sent, it opens in Excel 2003 in 2 columns just as it does when the code opens it. When I look at the file in notepad the first line of data looks like this:

"VarName";"TimeString";"VarValue";"Validity";"Time_ms"
"ESTATS PASTES 1.CT001";"30/12/2009 17:28:51";353;1;40177728368,0556

It appears that this value (40177728368,0556) represents the date/time. 40177 is the Excel's numeric representation of 30 December 2009 and
728368 is the fractional part of the day that yields the time (17:28:51)
Actually if you format .728368 with "hh:mm:ss.000" you get 17:28:50.995, if you format .7283680556 with "hh:mm:ss.000" you get 17:28:51.043 both of which would round to the time shown in column A. Since the title of that column is includes a reference milliseconds (ms), it could also be that the time is 17:28:51.0556. If that level is accuracy is important (doubtful) you would have to check the source of the data to be sure. I believe that the digits in column B should be appended to the previous ones and converted using the Excel time function.

Option Explicit
Sub CollectDataFromFilesInSubDirsToArray()
    'Original Recursive File List code (very cool) from
    'http://www.mrexcel.com/forum/showthread.php?t=35674
 
    Dim lFilesCount As Long
    Dim aryFiles()
    Dim lX As Long
    Dim sFilePathAndName As String
    Dim sFileName As String
    Dim iDestinationColumn As Integer
    Dim lLastDataRow As Long
    Dim lFileCount As Long
    Dim strDir As String
    Dim intCheck As Integer
 
    On Error GoTo Error_Handler
 
    Application.ScreenUpdating = False
 
    strDir = ThisWorkbook.Path 'Start search in the directory this program is in
 
    With Application.FileSearch
        .NewSearch 'Search criteria settings to defaults
        .Filename = "*.csv"
        .FileType = msoFileTypeAllFiles
        .LookIn = strDir
        .SearchSubFolders = True
        If .Execute() > 0 Then
            ReDim aryFiles(.FoundFiles.Count)
            aryFiles = Array(.FoundFiles)
        End If
    End With
    'FilePath/Name is stored in
    'aryFiles(0).Item(1) 'through
    'aryFiles(0).Item(aryFiles(0).Count)
 
    lFileCount = aryFiles(0).Count
 
    If lFileCount > 0 Then
        ThisWorkbook.ActiveSheet.Cells.Clear
    End If
 
    For lX = 1 To lFileCount
        Application.StatusBar = "Processing file " & lX & " of " & lFileCount
        sFilePathAndName = aryFiles(0).Item(lX)
        sFileName = Right(sFilePathAndName, Len(sFilePathAndName) - InStrRev(sFilePathAndName, "\"))
 
        If InStr(sFileName, ".csv") > 0 Then 'Only work with .csv files (may need to add other restrictions)
 
            Workbooks.Open Filename:=sFilePathAndName, _
                Notify:=False, UpdateLinks:=False, ReadOnly:=True
            
            lLastDataRow = Cells(Rows.Count, 2).End(xlUp).Row
            
            'Check for # semicolons in A1 of the opened file
            intCheck = Len(Range("A1").Value) - Len(Replace(Range("A1").Value, ";", ""))
            
            Select Case intCheck
            Case 0
                'Don't need to parse
            Case 4
                'Parse first column into 4 columns
                Columns("B:E").Select
                Selection.Insert Shift:=xlToRight
                Range("A1:A" & lLastDataRow).Select
                Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                    Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
                    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
                    TrailingMinusNumbers:=True
                Cells.Select
                Cells.EntireColumn.AutoFit
            Case Else
                MsgBox "Column A is int on the expected format"
                GoTo End_Sub
            End Select
            
            If lX = 1 Then
                'Copy column B
                iDestinationColumn = 1
 
                ActiveSheet.Range(Cells(2, 2), Cells(lLastDataRow, 2)).Select
                Stop ' see if the correct column B data is selected in first file
                'If it is you can delete the 3 lines in this codeblock
 
                ActiveSheet.Range(Cells(2, 2), Cells(lLastDataRow, 2)).Copy _
                    Destination:=ThisWorkbook.ActiveSheet.Range("A2")
                ThisWorkbook.Worksheets(1).Cells(1, 1) = "Time"
            End If
 
            'Copy Column C
            iDestinationColumn = iDestinationColumn + 1
 
            ActiveSheet.Range(Cells(2, 3), Cells(lLastDataRow, 3)).Select
            Stop ' see if the correct column C data is selected in each file
            'If it is you can delete the 3 lines in this codeblock
 
            ActiveSheet.Range(Cells(2, 3), Cells(lLastDataRow, 3)).Copy _
                Destination:=ThisWorkbook.ActiveSheet.Cells(2, iDestinationColumn)
            ThisWorkbook.Worksheets(1).Cells(1, iDestinationColumn) = _
                Left(sFileName, Len(sFileName) - 4)
 
            ActiveWorkbook.Saved = True 'shouldn't be needed for a .csv file, but ...
            ActiveWorkbook.Close
 
        End If
    Next
 
    Cells.Columns.AutoFit
    
    MsgBox "Processing Complete.  Imported " & iDestinationColumn - 1 & " files."
 
    GoTo End_Sub
 
Error_Handler:
    Debug.Print Err.Number
    Debug.Print Err.Description
    MsgBox "Error" & vbCrLf & vbCrLf & Err.Number & vbCrLf & Err.Description
 
End_Sub:
    Application.ScreenUpdating = True
    Application.StatusBar = False
    
End Sub

 

[eshtica]

Hi Phil,

Sorry for the lack of response, I have been away for a while and only now I got back to the office.
Your code is now working as it should for all files except for the 1st one.

Istead of copying all the time values from column B of data file to column A in master it just copies the title "TimeString" to cell A2 and nothing else.
Then it does the same for the VarValue of the 1st file as well; it just copies the title "VarValue" to cell B2 and nothing else.

To sum up, at the first stop you planned the data file is still looking like ; formated (all in column A) and the selection is only for cells B1 and B2.



For all the other files it is working perfect, I must say.


Thank you very much.


Best regards