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

Ostoop

New Member
Joined
Sep 19, 2014
Messages
5
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

Code:
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
 

Some videos you may like

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,431
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.
Code:
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

New Member
Joined
Sep 19, 2014
Messages
5
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

New Member
Joined
Oct 24, 2014
Messages
2
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.
Code:
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

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,431

ADVERTISEMENT

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

New Member
Joined
Jan 22, 2015
Messages
1
Dear John,

your macro saved me today. It's brilliant !

Thanks a lot
Patricia
 
Last edited:

golfer931

New Member
Joined
Feb 10, 2015
Messages
2

ADVERTISEMENT

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

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,431
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:
Code:
With ActiveSheet
    r = .UsedRange.Row + .UsedRange.Rows.Count
    Set destCell = .Cells(r, "B")
End With
to:
Code:
With ActiveSheet
    .Cells.ClearContents
    Set destCell = .Cells(2, "B") 'OR Set destCell = .Range("B2")
End With
 

Watch MrExcel Video

Forum statistics

Threads
1,109,369
Messages
5,528,287
Members
409,814
Latest member
Leon_Al

This Week's Hot Topics

  • Change military grades into rank
    Afternoon all Need help with formula that will change military rank (i.e. 1, 2, 3 into Amn, A1C, SrA). Running IF formula that does not work...
  • VBA COUNTIF SOLUTION
    Hi The following are the errors spread across the several columns from E to Q ie. 13 columns across several sheets with more than 500 rows per...
  • INSERT ROW WITH SPECIFIS TEXT IN A COLUMN
    Hi All! How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F. If I record the...
  • Auto-Create a monthly Sign in sheet for preschool students
    The image below is what each page looks like. Above is space for the "Child Name" "Month" "Class" School days are obviously Monday-Friday but...
  • VBA vlookup multiple results
    Hi folks, Hopefully someone out there can help. I have a list to vlookup which works (ish). the lookup only picks up the first instance of the...
  • Extract values for earliest/latest times
    I am trying to put together a formula to get the earliest start time, the latest end time from column A for each person in Column B-F without the...
Top