Transposing data from multiple csv files into one xlsx file

[Rnkhch]

Hello,

I have data in many csv files (more than 500, each corresponding to one person's scores), and I need to combine the data into one file, in transposed form (i.e. rows instead of columns), for easier visualization and processing. Each file contains 5 columns with the same headings (course names), and there is a one row gap between the headings and the data.

Over the weekend, I tried to merge the data manually by creating a blank xlsx file with five sheets (each corresponding to one course). I typed the name of each file (i.e. person) in the first cell of each row and transposed the data right next to it. Considering that there are over 500 files and 5 columns in each, I need to open+select+copy+transpose more than 2500 times and I was only able to do this for 50 people before getting way too tired

Is there any way to automate this process? I would highly appreciate any insights! Thanks a lot!

P.S. Here is an example of how the data looks like:
Person1.csv
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Physics
[/TD]
[TD]Chemistry
[/TD]
[TD]Math
[/TD]
[TD]Biology
[/TD]
[TD]Statistics
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]98
[/TD]
[TD]94
[/TD]
[TD]99
[/TD]
[TD]89
[/TD]
[TD]93
[/TD]
[/TR]
[TR]
[TD]95
[/TD]
[TD]88
[/TD]
[TD]92
[/TD]
[TD]91
[/TD]
[TD]96
[/TD]
[/TR]
[TR]
[TD]etc
[/TD]
[TD]etc
[/TD]
[TD]etc
[/TD]
[TD]etc
[/TD]
[TD]etc
[/TD]
[/TR]
</tbody>[/TABLE]


And here is how I want the data to look like in the final file:
e.g. for Physics sheet:

[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD]Person1
[/TD]
[TD]98
[/TD]
[TD]95
[/TD]
[TD]etc
[/TD]
[/TR]
[TR]
[TD]Person2
[/TD]
[TD]78
[/TD]
[TD]81
[/TD]
[TD]etc
[/TD]
[/TR]
[TR]
[TD]etc
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
And there are 4 other sheets in the file for the other courses.

 

[Worf]

Do you still need help with this one?

 

[Rnkhch]

I manually did the portion of data that I had which was painstaking but more will come next year, so if there is an easy way, please let me know. Thanks a lot!

 

[ask2tsp]

please open workbook https://www.dropbox.com/s/m031paowix5nd8q/csv2xls.xlsm?dl=0

fill in the name of the folder where all your csv files are located and click the blue arrow

 

[Rnkhch]

Thank you so much! You are number one

 

[Macropod]

please open workbook https://www.dropbox.com/s/m031paowix5nd8q/csv2xls.xlsm?dl=0

As per our Rule 4 (https://www.mrexcel.com/forum/board-announcements/99490-forum-rules.html), kindly don't create solutions elsewhere then post those solutions via file links - answer the question within the thread itself.

 

[ask2tsp]

@Macropod: elsewhere was on my pc. When I finished the product it was a bit of a stretch to explain the lot. That's why I chose to publish the whole workbook. But you are right in that it defeates the purpose of a forum. So here are the codes used:

general module

Option Explicit

Function selectFolder(defaultFolder) As String
    If IsEmpty(defaultFolder) Then defaultFolder = Application.DefaultFilePath
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = defaultFolder
        .Title = "Please select a folder"
        If .Show = -1 Then  'user clicked ok?
            selectFolder = IIf(.SelectedItems.Count = 0, defaultFolder, .SelectedItems(1) & "\")
        Else
            selectFolder = defaultFolder
        End If
    End With
End Function

Sub collect()
    Static fso As FileSystemObject
    Dim csvFolder As Folder, csvFolderName As String, csvFile As File
    Dim content As TextStream, csvText As String, person As String
    Dim physics() As Variant, Chemistry() As Variant
    Dim Math() As Variant, Biology() As Variant, Statistics() As Variant
    Dim size As Integer, r As Integer, lines() As String, i As Integer
    Dim v() As String, delim As String
    
    If fso Is Nothing Then Set fso = New FileSystemObject
    
    csvFolderName = shtControl.Range("csvFolder")
    
    If Not fso.FolderExists(csvFolderName) Then
        MsgBox "Folder " & csvFolderName & " not found"
        Exit Sub
    End If
    
    delim = shtControl.Range("seperatorChar")
    
    Set csvFolder = fso.GetFolder(csvFolderName)
    
    size = csvFolder.Files.Count - 1
    ReDim physics(size, 6), Chemistry(size, 6), Math(size, 6), _
          Biology(size, 6), Statistics(size, 6)
    
    For Each csvFile In csvFolder.Files
    If csvFile.Name Like "*.csv" Then
        person = Left(csvFile.Name, InStr(csvFile.Name, ".") - 1)
        Set content = csvFile.OpenAsTextStream(ForReading, TristateUseDefault)
        csvText = content.ReadAll
        content.Close
        
        physics(r, 0) = person
        Chemistry(r, 0) = person
        Math(r, 0) = person
        Biology(r, 0) = person
        Statistics(r, 0) = person
        
        lines = Split(csvText, vbLf)
        For i = 1 To UBound(lines) - 1
            v = Split(lines(i), delim)
            physics(r, i) = v(0)
            Chemistry(r, i) = v(1)
            Math(r, i) = v(2)
            Biology(r, i) = v(3)
            Statistics(r, i) = v(4)
        Next i
        r = r + 1
    End If
    Next csvFile
    
    shtPhysics.UsedRange.Clear
    shtPhysics.Range("A1").Resize(UBound(physics, 1), 6) = physics
    shtChemistry.UsedRange.Clear
    shtChemistry.Range("A1").Resize(UBound(Chemistry, 1), 6) = Chemistry
    shtMath.UsedRange.Clear
    shtMath.Range("A1").Resize(UBound(Math, 1), 6) = Math
    shtBiology.UsedRange.Clear
    shtBiology.Range("A1").Resize(UBound(Biology, 1), 6) = Biology
    shtStatistics.UsedRange.Clear
    shtStatistics.Range("A1").Resize(UBound(Statistics, 1), 6) = Statistics
End Sub

Control sheet code (codename shtControl

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = Range("csvFolder").Address Then
        Target.Value = selectFolder(Target.Value)
    End If
End Sub

 

[Rnkhch]

I received some score sheets with different course names, so I'll attempt to see if I can make the substitutions correctly in your code and get it to work, but if I don't succeed, I'll reach out

 

[ask2tsp]

Hold your horses. I'm working on a solution that works with any number of courses. Expect to deliver today or tomorrow.

 

[Rnkhch]

Sure, thanks! I tried to make some changes and struggled badly