Changing the structure of a csv file

Dear members,

I need your help to change the structure of csv file, A, to B in a new csv file, please.

I tried to record macro but it was not useful. There are some missing values in dataset (blank cells), but I couldn't fill them in format A because of blank cells in Feb and other non-31-day months.

I know how to run the code for the files in a folder, but for this part I need your assistance.
Reagrds,
Mori

[File A]
A1 B1 C1
A2 B2 C2
A3 B3 C3
A4
A5
>> change structure to >>
[File B]
A1
A2
A3
A4
A5
B1
B2
B3
C1
C2
C3

changing structure.png

Please post at least one copy of each CSV, BEFORE.csv and AFTER.csv

Click on GO ADVANCED and use the paperclip icon to open the upload window.

View Pic

This does all the formatting in memory so it should be pretty fast.

Option Explicit

Sub CSVconverter()
Dim wbCSV As Workbook, MyArr As Variant, NewArr As Variant
Dim LR As Long, NR As Long, i As Long, j As Long

    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .AllowMultiSelect = False
        .Filters.Add "CSV Files", "*.csv", 1  'default
        .ButtonName = "SELECT"
        .Title = "Select CSV file"
        .Show
        If .SelectedItems.Count > 0 Then
            Set wbCSV = Workbooks.Open(.SelectedItems(1))
        Else
            Exit Sub
        End If
    End With

    LR = Range("A" & Rows.Count).End(xlUp).Row
    MyArr = Range("A1:N" & LR).Value
    ReDim NewArr((WorksheetFunction.Count(Range("A1:N" & LR)) + 1000), 2)
    NewArr(0, 1) = "Date": NewArr(0, 2) = "Value"
    NR = 1

    For i = 2 To UBound(MyArr, 1)
        For j = 3 To 14
            If IsDate(MyArr(1, j) & " " & MyArr(i, 2) & ", " & MyArr(i, 1)) Then
                NewArr(NR, 1) = Format(DateValue(MyArr(1, j) & " " & MyArr(i, 2) & ", " & MyArr(i, 1)), "MM/DD/YYYY")
                NewArr(NR, 2) = MyArr(i, j)
                NR = NR + 1
            End If
        Next j
    Next i

    Sheets.Add
    Range("A1:C" & UBound(NewArr)).Value = NewArr
    Range("A:A").Delete xlShiftToLeft
    Range("A:B").Sort Range("A2"), xlAscending, Header:=xlYes
    ActiveSheet.Move
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=Replace(wbCSV.FullName, ".csv", "-NEW.csv"), FileFormat:=xlCSV, CreateBackup:=False
    ActiveWorkbook.Close False
    wbCSV.Close False
    
End Sub

Wow, Thank you for the time. The program is so fast. But there are only two small issues, if you consider it please.

1. The code crawls data by row rather than column. I.e. it reads Jan 1,1950 then Feb 1,1950 instead of Jan 1, 1950 then Jan 2, 1950 ...

2. There are some blank cells, as missing value, other than months with less than 31-day. The code is ignoring the whole months with missing values. (e.g., Jun 1951)
11-23-2015 2-15-30 PM.png
I've used this code after running your code and it has inserted the missing dates. Since it is for 3 columns dataset, so I just inserted a blank column between columns date and value.

Sub insert_missing_dates_modified()
'TXT2colm recorded macro to adjust date col
'MDY to DMY to prevent mismatching error
Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        FieldInfo _
        :=Array(1, 4), TrailingMinusNumbers:=True
'
'Original Code for inserting missing dates
Dim b As Object, c, q As Long, r As Long
Dim u(), x, y
r = Cells(Rows.Count, 1).End(xlUp).Row
x = Cells(3, 1): y = Cells(r, 1)
Set b = CreateObject("scripting.dictionary")
ReDim u(1 To y - x + 1, 1 To 3)
For Each c In Range("A3:A" & r).Value
    b(c) = 1
Next c
For c = x To y
    If Not b(c) = 1 Then
        q = q + 1
        u(q, 1) = c
        u(q, 3) = "NA"
    End If
Next c
If q > 0 Then
    Cells(r + 1, 1).Resize(q, 3) = u
    Cells(3, 1).Resize(r - 2 + q, 3).Sort Cells(3, 1), Header:=xlNo
End If
MsgBox q & " rows inserted"
End Sub

1) I don't see a problem with #1. It is running row by row so the initial array created is in the monthly format, day by day, but at the end of the macro the data is sorted by date ascending putting the output back in calendar date ascending.

2) The macro skips any cell with NO VALUE. It does not skip 0 value cells. What is the need in that regard?

I have edited one line of code above in red. That seems to fix #2.
Attachment updated as well.

If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED. Thanks.

Hello again,
I have a question, if you don't mind.

How to do it for multiple files in a folder?
Thanks.

So instead of picking a file at the beginning, you want to select a folder and have it process every Excel file in that folder?

Yes please.
I have actually recorded a macro, and I am trying to add your code to the end of that. Then I am going to add another macro to merge all created files by your code into one workbook.

This version will make the original macro I wrote loop through all CSV files found in a chosen folder:

Option Explicit

Sub CSVconverter()
Dim csvPATH As String, csvNAME As String, wbCSV As Workbook, MyArr As Variant, NewArr As Variant
Dim LR As Long, NR As Long, i As Long, j As Long

    With Application.FileDialog(msoFileDialogFolderPicker)      'Folder selection
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        .Title = "Select a folder with CSVs to convert"
        .ButtonName = "Choose this CSV folder"
        .Show
        If .SelectedItems.Count > 0 Then csvPATH = .SelectedItems(1) & "\" Else Exit Sub
    End With

    csvNAME = Dir(csvPATH & "*.csv")                            'get first filename
    
    If Len(csvNAME) = 0 Then                                    'make sure at least 1 was found
        MsgBox "No CSV files were found in the chose folder"
        Exit Sub
    End If
    
    Do While Len(csvNAME) > 0                                   'keep repeating til no more files found
        Set wbCSV = Workbooks.Open(csvPATH & csvNAME)             'open the found dile
        LR = Range("A" & Rows.Count).End(xlUp).Row              'last row of data
        MyArr = Range("A1:N" & LR).Value                        'read the data into memory
        ReDim NewArr((WorksheetFunction.Count(Range("A1:N" & LR)) + 1000), 2)   'create output array
        NewArr(0, 1) = "Date": NewArr(0, 2) = "Value"           'add headers
        NR = 1                                                  'first empty row in new array
    
        For i = 2 To UBound(MyArr, 1)                           'realign old array into new array
            For j = 3 To 14
                If IsDate(MyArr(1, j) & " " & MyArr(i, 2) & ", " & MyArr(i, 1)) Then
                    NewArr(NR, 1) = Format(DateValue(MyArr(1, j) & " " & MyArr(i, 2) & ", " & MyArr(i, 1)), "MM/DD/YYYY")
                    NewArr(NR, 2) = MyArr(i, j)
                    NR = NR + 1
                End If
            Next j
        Next i
    
        Sheets.Add                                              'create an output sheet
        Range("A1:C" & UBound(NewArr)).Value = NewArr           'write out the new array
        Range("A:A").Delete xlShiftToLeft                       'cleanup
        Range("A:B").Sort Range("A2"), xlAscending, Header:=xlYes
        ActiveSheet.Move                                        'move the sheet to a new workbook and save it as CSV-NEW
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=Replace(wbCSV.FullName, ".csv", "-NEW.csv"), FileFormat:=xlCSV, CreateBackup:=False
        ActiveWorkbook.Close False                              'close the created file
        wbCSV.Close False                                       'close the found file
    
        csvNAME = Dir                                           'get the next filename
    Loop
End Sub

Thank you. I think there is a problem in my side. The program cannot find csv files in the folder.

My bad, a few typos, I've corrected them in the post above and tested, it is finding the CSV files now. Apologies.