Macro To Read .csv Files into Spreadsheet Colums and Label By Filename

[AKsizzle47]

Hello. I seek assistance creating a macro that will enable me to read csv files into Excel. What I have are many csv files in "my documents" folder corresponding to data I acquired. There are four csv files per trial for my experiment which I want to keep. All four file names start by specifying what they are and have the trial label at the end, for example "density_A1.csv, length_A1.csv, concentration_A1.csv, speed_A1.csv, density_A2.csv, length_A2.csv" ...and so on. There's a lot of files. What I want to do is automatically open each measurement file as a column of data in excel, and have each separate trial be a sheet named by the trial label. For example sheet names being "A1, A2, A3, B1, B2" etc., with four columns of measurement data per sheet. I don't need the columns themselves to be labeled, I just need each column to depict the same measurement in each sheet. Thank you so much for any code and/or insight as to how to do this. I'm hoping I can come out of this not only with working code but also be a better macro writer too. Cheers!

 

[bertie]

Hi, and welcome to the forum.

I have used a couple of functions to strip out the various part of the file name.

First we need to get the sheet name
The function takes the filename as an argument and string out the characters between the underscore and the period.

Private Function GetSheetName(ByVal FileName As String) As String
   Dim startChar As Long
   Dim endChar As Long
   
   startChar = InStr(1, FileName, "_", vbTextCompare) + 1
   endChar = InStr(1, FileName, ".", vbTextCompare)
   
   GetSheetName = Mid(FileName, startChar, endChar - startChar)
End Function

We also need to determine the output column.
Again we pass the filename as an argument,
strip out the characters to the left of the underscore,
and use a Select Case statement to determine the out put column.

Private Function OutputColumn(ByVal FileName As String) As Long
   Dim ColumnName As String
   
   ColumnName = UCase(Left(FileName, InStr(1, FileName, "_", vbTextCompare) - 1))
   
   Select Case ColumnName
      Case "DENSITY"
         OutputColumn = 1
      Case "LENGTH"
         OutputColumn = 2
      Case "CONCENTRATION"
         OutputColumn = 3
      Case Else
         OutputColumn = 4
   End Select
End Function

After we open the source file we need to determine the number of rows to copy.
I have assumed the data is in column A.
This time we pass the worksheet as an argument and get the range in column A to copy.

Private Function GetSourceRange(ByVal ws As Worksheet) As String
   Dim lr As Long
   lr = ws.Range("A" & Rows.Count).End(xlUp).Row
   
   GetSourceRange = "A1:A" & lr
End Function

There is a procedure to insert headers in newly created worksheets.

Private Sub InsertHeaders(ByVal SheetName As String)
   With Sheets(SheetName)
      .Range("A1").Value = "Density"
      .Range("B1").Value = "Length"
      .Range("C1").Value = "Concentration"
      .Range("D1").Value = "Speed"
   End With
End Sub

The Main() procedure loops through all the csv file in the folder
NB You will need to edit the folder path REMEMBER THE END BACKSLASH.

Sub Main()
   Dim sPath As String
   Dim sFile As String
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim wsTarget As Worksheet
   Dim rw As Long             'output row
   Dim col As Long            'output column
   Dim SheetName As String
   Dim copyRange As String
   
   sPath = "C:\temp\MrExcel\" 'REMEMBER END BACKSLASH
   
   sFile = Dir(sPath & "*.csv")
   Do Until sFile = ""
      
      '==============================================
      'get sheet name,
      'test if sheet name exists, if not create it
      '==============================================


      SheetName = GetSheetName(sFile)


      On Error Resume Next
      Set wsTarget = Sheets(SheetName)
      If wsTarget Is Nothing Then
         Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = SheetName
         Set wsTarget = Sheets(SheetName)
         'insert headers
         InsertHeaders SheetName
      End If
      On Error GoTo 0
      
      '==================================
      'get the output column
      '=================================
      col = OutputColumn(sFile)
      
      '=================================
      'open source file
      'get the number of rows to copy
      '===============================
      Set wbSource = Workbooks.Open(sPath & sFile)
      Set wsSource = wbSource.Worksheets(1)
      copyRange = GetSourceRange(wsSource)
      
      '==================================
      'copy and paste
      '==================================
      wsSource.Range(copyRange).Copy Destination:=wsTarget.Cells(2, col)
      
      '===========================
      'close file and tidy up
      '==========================
      Set wsSource = Nothing
      wbSource.Close SaveChanges:=False
      Set wbSource = Nothing
      Set wsTarget = Nothing
      
      'get next file
      sFile = Dir()
   Loop
End Sub

Place all the code above into a standard module, i.e., Insert=>Module.

Test initially using a couple of files and press F8 to step through the code one line at a time. This will give you a better understanding of what the code does.

Hope this helps,
Bertie

 

[AKsizzle47]

Bertie, first off thank you for welcoming me to the forum with your generous help. I have run the code, modifying path names appropriately, but am still having a problem specifically with the column identification. I think the problem lies within the second block of code. Right now I am getting the sheets created and labeled as planned, however only the 4th column of data is entering the sheet (which I called "speed"). I am thinking that this is due to the "case else" command, meaning the "case length", "case density" etc functions are not finding the data as we'd hoped. Also I did not mention in my initial post that there is more than one underscore per filename (eg. density_catheter_A1_1). I thought this might be the problem, however I manually deleted the 2nd and 3rd underscores from the file names for testing purposes, to no avail. So I don't think that's causing the problem but I thought it's worth mentioning. I now come back for help, I've troubleshooted all I can. Thank you.

Ps: I wanted to specify that the excel outputs have both appropriate sheet names AND column labels. It's just that three of the four properly labeled columns have no data underneath.

 

[bertie]

Obviously if the file name is different from your original post my code will not work as intended.

The Main() procedure is ok but we will need to change the function to strip out the sheet name.

We can use the SPLIT function to separate the file name into it's component part, using the hyphen character as the separator.
We would assign this to an array variable.
i.e.,
arr=Split(Filename,"-")

Using the filname format: density_catheter_A1_1, we can visualize the array storing the values as:
arr(0) = "density"
arr(1) = "catheter"
arr(2) = "A1"
arr(3) = "1"

i.e., the arr(2) element will hold the sheet name.

Using this approach the GetSheetName function would now be:

Private Function GetSheetName(ByVal FileName As String) As String
   Dim arr As Variant
   
   arr = Split(FileName, "-")
   GetSheetName = arr(2)
   
End Function

NB this is untested


Select Case Statement
Case Else is used as a default. If basically says, if it is not; density, length or concentration, then it must be "speed". You can hard code "speed" to go into column 4, and add as many parameters as you like. NB enter these as upper case.

The OutputColumn() function tests on the first word of the file name up to the underscore. Check my spelling.

 

[AKsizzle47]

Bertie, thank you tremendously for your assistance. For whatever reason, the new GetSheetName works for only the first entry and does not loop. However, I instead successfully modified the original GetSheetName you provided by adding +8 to the startChar function rather than +1 to surpass unwanted parts of the filename. I then used the SPLIT function instead to name each column, taking the first section, arr(0), of the filename, again with success. Though probably an easy problem to solve for you, I was clueless but now have perfectly working code saving my hours of time. I also felt as though I learned a thing or two about VB code structure. I have accomplished both things I sought out to do and have you to thank for you fast, detailed replies. Terrific forum.

 

[AKsizzle47]

I now have a new issue that is similar but stumping me again, perhaps someone can help. I wish to add a fifth column of data to the sheets created previously. This time I have .txt files that I want to add. The text files have 6 columns each of one single data entry with label above. I wish to extract the single data value from only the last data column, and input that into the corresponding sheet created from my earlier issue. Each .txt file has a new naming system too where the beginning of the filename is different but end the same way. For instance, I now have NOL_A1_site1.txt, NOL_A1_site2.txt, etc. Each text file has a matrix of data but I only want the 8th column, 3rd row down value. I'm hoping this value can appear in the 5th column of data with the others, labeled "NOL". I tried to modify the code on my own but am for some reason unable to specify the 8th row 3rd column, instead it is inputting labels into my datasheet. Also for some reason it is not labeleing the column at all, though I thought I was following the same procedure as previously specified. Anyway, any help is appreciated or let me know if clarifications are needed. Cheers!