VBA - Importing CSV - Start column B; File name column A

[Ostoop]

I found a VBA code online to import data from CSV files and paste into the active Excel sheet. I already edited a few parts but can't get the last bit right.

What it currently does:
- Imports data (2nd row down) from all CSV files in same folder as main file (.xlsx) is stored
- Pastes data in active Excel sheet from row 2 down, all CSV files combined

What I still need is:
- Instead of pasting the data from Column A to ## I want to paste the data from Column B to ##, leaving Column A blank
- In Column A, I want the file name of the imported files, if for example the first file contains 10 data rows and the 2nd contains 20 data rows then the XLSX after running the macro will contain 30 data rows, the first column must show where the data originated from
- If possible I'd like to pick the files up from a subfolder, so the XLSX is not placed in the same folder as the imported CSV files

I'd be very greatful for anyone being able to help me with one or more of above improvements. Please find current code below.

Thank you

---

Sub ImportAllCSV()
  Dim FName As Variant, R As Long
  R = ActiveSheet.UsedRange.Rows.Count + 1
  FName = Dir("*.csv")
  Do While FName <> ""
    ImportCsvFile FName, ActiveSheet.Cells(R, 1)
    R = ActiveSheet.UsedRange.Rows.Count + 1
    FName = Dir
    
  Loop
End Sub


Sub ImportCsvFile(FileName As Variant, Position As Range)
  With ActiveSheet.QueryTables.Add(Connection:= _
      "TEXT;" & FileName _
      , Destination:=Position)
      .Name = Replace(FileName, ".csv", "")
      .FieldNames = True
      .RowNumbers = False
      .FillAdjacentFormulas = False
      .RefreshOnFileOpen = False
      .BackgroundQuery = True
      .RefreshStyle = xlInsertDeleteCells
      .SavePassword = False
      .SaveData = True
      .AdjustColumnWidth = False
      .TextFilePromptOnRefresh = False
      .TextFilePlatform = xlMacintosh
      .TextFileStartRow = 2
      .TextFileParseType = xlDelimited
      .TextFileTextQualifier = xlTextQualifierDoubleQuote
      .TextFileConsecutiveDelimiter = False
      .TextFileTabDelimiter = False
      .TextFileSemicolonDelimiter = False
      .TextFileCommaDelimiter = False
      .TextFileSpaceDelimiter = False
      .TextFileOtherDelimiter = ";"
      .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
      .Refresh BackgroundQuery:=False
  End With
End Sub

 

[John_w]

Try this. You need to edit the code where commented to define the subfolder (relative to the location of the workbook) containing the CSV files.

Public Sub ImportAllCSV()

    Dim FName As Variant, r As Long
    Dim destCell As Range
    Dim csvFolder As String
    
    csvFolder = ThisWorkbook.Path & "\CSV FILES SUBFOLDER\"    'CHANGE THIS FOLDER PATH
    If Right(csvFolder, 1) <> "\" Then csvFolder = csvFolder & "\"
    
    With ActiveSheet
        r = .UsedRange.Row + .UsedRange.Rows.Count
        Set destCell = .Cells(r, "B")
    End With
    
    FName = Dir(csvFolder & "*.csv")
    Do While FName <> ""
        r = ImportCsvFile(csvFolder & FName, destCell)
        destCell.Offset(0, -1).Resize(r, 1).Value = FName
        Set destCell = destCell.Offset(r, 0)
        FName = Dir
    Loop
    
End Sub


Private Function ImportCsvFile(FileName As String, Position As Range) As Long
    With Position.Parent.QueryTables.Add(Connection:="TEXT;" & FileName, Destination:=Position)
        .Name = Replace(FileName, ".csv", "")
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = xlMacintosh
        .TextFileStartRow = 2
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = ";"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .Refresh BackgroundQuery:=False
        ImportCsvFile = .ResultRange.Rows.Count
        .Delete
    End With
End Function

 

[Ostoop]

Very nice, that did everything it needs to do!

Hopefully I'll learn all that and more in the VBA course I'm going to do somewhere this year.

Thank you!

 

[mfoppa]

Try this. You need to edit the code where commented to define the subfolder (relative to the location of the workbook) containing the CSV files.

Public Sub ImportAllCSV()

    Dim FName As Variant, r As Long
    Dim destCell As Range
    Dim csvFolder As String
    
    csvFolder = ThisWorkbook.Path & "\CSV FILES SUBFOLDER\"    'CHANGE THIS FOLDER PATH
    If Right(csvFolder, 1) <> "\" Then csvFolder = csvFolder & "\"
    
    With ActiveSheet
        r = .UsedRange.Row + .UsedRange.Rows.Count
        Set destCell = .Cells(r, "B")
    End With
    
    FName = Dir(csvFolder & "*.csv")
    Do While FName <> ""
        r = ImportCsvFile(csvFolder & FName, destCell)
        destCell.Offset(0, -1).Resize(r, 1).Value = FName
        Set destCell = destCell.Offset(r, 0)
        FName = Dir
    Loop
    
End Sub


Private Function ImportCsvFile(FileName As String, Position As Range) As Long
    With Position.Parent.QueryTables.Add(Connection:="TEXT;" & FileName, Destination:=Position)
        .Name = Replace(FileName, ".csv", "")
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = xlMacintosh
        .TextFileStartRow = 2
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = ";"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .Refresh BackgroundQuery:=False
        ImportCsvFile = .ResultRange.Rows.Count
        .Delete
    End With
End Function

Excuse interfering in your thread. But I would like to know how to import files from a folder and transform a multiple line csv file in a single line in excel.

Ex:
c:\folder\File1.csv (10/24/2014)
"var, vara, varb, varc
var1, 1, 0, 30
var2, 0, 0, 40
var3, 1, 1, 20"

c:\folder\File2.csv (09/20/2014)
"var, vara, varb, varc
var1, 0, 0, 30
var2, 0, 0, 10
var3, 0, 1, 10"


Final excel merged file:
filename filedate vara1 vara2 vara3 varb1 varb2 varb3 varc1 varc2 varc3
File1.csv 10/24/2014 1 0 1 0 0 1 30 40 20
File2 .csv 09/20/2014 0 0 0 0 0 1 30 10 10


Thank you so much
Murilo

 

[John_w]

Murilo, since your question is different to the OP's, please start your own thread, linking to this one if you think it would help.

 

[PatriciaW]

Dear John,

your macro saved me today. It's brilliant !

Thanks a lot
Patricia

 

[golfer931]

I have been playing around with this code from John_w the past couple days, but haven't been able to figure this out as I am very new to this... How can I get this to start filling out the new worksheet at a given cell? Currently it seems to start at the last used cell, but I can't figure out how to control where it starts. Essentially what I want to do with this is put a button at the top of the worksheet that will 'update' the data by clearing the existing data then running the macro again. I am only having trouble figuring out how to get it to start at a given cell. Any help would be greatly appreciated, but please let me know if I should start a new thread.

 

[John_w]

golfer931, I've just replied to your PM, so will post the code change here for the benefit of others.

To clear the existing data and start the data importing at B2 every time the macro is run (the macro puts the file name of each .csv file imported into the rows in the column 1 to the left (column A in this case)), change:

With ActiveSheet
    r = .UsedRange.Row + .UsedRange.Rows.Count
    Set destCell = .Cells(r, "B")
End With

to:

With ActiveSheet
    .Cells.ClearContents
    Set destCell = .Cells(2, "B") 'OR Set destCell = .Range("B2")
End With

 

[golfer931]

This worked perfectly! Thank you for all your help!