Changing the structure of the files

Hello members,
I would appreciate if you could help me to change the structure of all my *.csv files to the following format and write them all in a single .xls file.
I tried to solve it by myself, but I didn't know even how to record a macro for this specific case.

INPUT FILE STRUCTURE (*.csv)
2-15-2015 4-03-41 PM.png

OUTPUT FILE STRUCTURE
** for the dates that there is no value (e.g. 30 & 31 Feb), you can leave it blank or fill it with "?" or "-999" as missing value.
2-15-2015 4-05-04 PM.png

Thank you.

Could you post an example CSV file for us to play with - perhaps with dummy data? What is the max number values for any given day? Could it be anything?

Originally Posted by Brendan_Floyde

Could you post an example CSV file for us to play with - perhaps with dummy data? What is the max number values for any given day? Could it be anything?

Sure, I'll update the main post by adding a sample file.
The max number of records in different files are not same and could be anything.
But, the structure of the input files is similar.
Thank you

As your data is nice and square adodb is way quicker than looping through each line. Requires a reference in the VBE go tools / references then tick microsoft active data objects 6.1 library (or the highest / nearest you have) - you only have to do this once.

this code assumes 1334108.csv is saved in the same directory as the file with the macro in.

This just transforms the one input csv file. You mention you have multiple in a folder. It's not clear how you want the data consolidated. Should the values be added together or new line for each input folder? Can you expand the output file example above to show what you want and also perhaps post a second input file?

Sub LoadCSVtoArray()

strPath = ThisWorkbook.Path & "\"

Set cn = CreateObject("ADODB.Connection")
strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath & ";Extended Properties=""text;HDR=Yes;FMT=Delimited"";"
cn.Open strcon

strSQL = "transform Sum(Value) SELECT id, Year, Day FROM 1334108.csv GROUP BY id, Year, Day PIVOT Month;"


Dim rs As Recordset
Dim rsARR() As Variant
Dim fldCount As Integer
Dim iCol As Integer
Dim iRow As Integer


Set rs = cn.Execute(strSQL)
rsARR = rs.GetRows

fldCount = rs.Fields.Count

    For iCol = 1 To fldCount
        Range("a1").Cells(1, iCol).Value = rs.Fields(iCol - 1).Name
    Next


rs.Close
Set cn = Nothing

Range("a2").Resize(UBound(rsARR, 2) + 1, UBound(rsARR, 1) + 1).Value = TransposeDim(rsARR)

End Sub
Function TransposeDim(v As Variant) As Variant
' Custom Function to Transpose a 0-based array (v)
    
    Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
    Dim tempArray As Variant
    
    Xupper = UBound(v, 2)
    Yupper = UBound(v, 1)
    
    ReDim tempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For Y = 0 To Yupper
            tempArray(X, Y) = v(Y, X)
        Next Y
    Next X
    
    TransposeDim = tempArray

End Function

Originally Posted by Brendan_Floyde

This just transforms the one input csv file. You mention you have multiple in a folder. It's not clear how you want the data consolidated. Should the values be added together or new line for each input folder? Can you expand the output file example above to show what you want and also perhaps post a second input file?

2-15-2015 8-17-21 PM.png
is it clear? No header no blank row in between.
Just added another sample file to the original post.
Thank you.

Just to clarify in your output example the column headings Val1 / val2 are effectively the months?

Amended the above for multiple files. Opens a dialogue box for you to select the files in the folder then cycles through and dumps them at the bottom of the table each time. There is no error checking - assumes all the input files are identical.

Sub LoadCSVtoArray()
Dim stFilename() As Variant
Dim stFilenamez As String
Dim a As Integer


stFilename() = Application.GetOpenFilename("Csv Files (*.csv), *.Csv", , "Open the .csv file to merge", , True)
        
For a = 1 To UBound(stFilename())

strfilenamez = Split(stFilename(a), "\")(UBound(Split(stFilename(a), "\")))

strPath = Replace(stFilename(a), strfilenamez, "", 1)

Set cn = CreateObject("ADODB.Connection")
strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath & ";Extended Properties=""text;HDR=Yes;FMT=Delimited"";"
cn.Open strcon

strSQL = "transform Sum(Value) SELECT id, Year, Day FROM " & strfilenamez & " GROUP BY id, Year, Day PIVOT Month;"


Dim rs As Recordset
Dim rsARR() As Variant
Dim fldCount As Integer
Dim iCol As Integer
Dim iRow As Integer


Set rs = cn.Execute(strSQL)
rsARR = rs.GetRows

fldCount = rs.Fields.Count

    For iCol = 1 To fldCount
        Range("a1").Cells(1, iCol).Value = rs.Fields(iCol - 1).Name
    Next


rs.Close
Set cn = Nothing

Cells(GetLastRow("Sheet1", "A") + 1, 1).Resize(UBound(rsARR, 2) + 1, UBound(rsARR, 1) + 1).Value = TransposeDim(rsARR)

Next a

End Sub
Function TransposeDim(v As Variant) As Variant
' Custom Function to Transpose a 0-based array (v)
    
    Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
    Dim tempArray As Variant
    
    Xupper = UBound(v, 2)
    Yupper = UBound(v, 1)
    
    ReDim tempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For Y = 0 To Yupper
            tempArray(X, Y) = v(Y, X)
        Next Y
    Next X
    
    TransposeDim = tempArray

End Function

Function GetLastRow(strSheet, strColum) As Long

 Dim MyRange As Range
 Dim lngLastRow As Long

    Set MyRange = Worksheets(strSheet).Range(strColum & "1")

    lngLastRow = Cells(1048576, MyRange.Column).End(xlUp).Row
    
    GetLastRow = lngLastRow
    
     Set MyRange = Nothing
 End Function

Could you run it again and when it error hit debug
then type ?strfilenamez
This will then tell you the file it errors out on - could you then post that file? Or rerun excluding that file and see it it gets further? I want to work out if it is a particular file that is the issue

Got the file - replicated the error....working on it. It is the problem I suspected....

Are all the files the same layout, with same headers etc?

Ahh so it's the files where the 1st record value is ? that is causing the issue as MS then thinks that field is text field rather than a value field.?

Hmm thinking cap on .... sure i've come across this before.....

added an error handling - 1534001 - has 59 initial records of ? . MS (jet) uses the first 10 records to judge the field type so in this instance it thinks it is a text field - hence the issue. There are other fancier ways of adjusting like adjusting the registry so jet looks at the whole column but this is fast and good enough

Sub LoadCSVtoArray()

On Error GoTo 0

Dim stFilename() As Variant
Dim stFilenamez As String
Dim a As Integer
Dim StrSQLcorr As String


stFilename() = Application.GetOpenFilename("Csv Files (*.csv), *.Csv", , "Open the .csv file to merge", , True)
        
For a = 1 To UBound(stFilename())

strfilenamez = Split(stFilename(a), "\")(UBound(Split(stFilename(a), "\")))

strPath = Replace(stFilename(a), strfilenamez, "", 1)

Set cn = CreateObject("ADODB.Connection")
strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath & ";Extended Properties=""text;HDR=Yes;FMT=Delimited"";"
cn.Open strcon


strsql = "transform Sum([Value])  SELECT id, Year, Day FROM " & strfilenamez & "  GROUP BY id, Year, Day PIVOT Month;"


On Error GoTo 0

Dim rs As Recordset
Dim rsARR() As Variant
Dim fldCount As Integer
Dim iCol As Integer
Dim iRow As Integer


On Error GoTo errorh:
Set rs = cn.Execute(strsql)
On Error GoTo 0

rsARR = rs.GetRows

fldCount = rs.Fields.Count

    For iCol = 1 To fldCount
        Range("a1").Cells(1, iCol).Value = rs.Fields(iCol - 1).Name
    Next


rs.Close
Set cn = Nothing

Cells(GetLastRow("Sheet1", "A") + 1, 1).Resize(UBound(rsARR, 2) + 1, UBound(rsARR, 1) + 1).Value = TransposeDim(rsARR)

Next a

Exit Sub
errorh:

strsql = "transform Sum([Value])  SELECT id, Year, Day FROM " & strfilenamez & " Where (value  <> '?') GROUP BY id, Year, Day PIVOT Month;"
Resume

End Sub
Function TransposeDim(v As Variant) As Variant
' Custom Function to Transpose a 0-based array (v)
    
    Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
    Dim tempArray As Variant
    
    Xupper = UBound(v, 2)
    Yupper = UBound(v, 1)
    
    ReDim tempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For Y = 0 To Yupper
            tempArray(X, Y) = v(Y, X)
        Next Y
    Next X
    
    TransposeDim = tempArray

End Function

Function GetLastRow(strSheet, strColum) As Long

 Dim MyRange As Range
 Dim lngLastRow As Long

    Set MyRange = Worksheets(strSheet).Range(strColum & "1")

    lngLastRow = Cells(1048576, MyRange.Column).End(xlUp).Row
    
    GetLastRow = lngLastRow
    
     Set MyRange = Nothing
 End Function