Import CSV into EXCEL, Insert Column Headers Automated

[Ifutant]

Hi,

I found a couple of different set of codes to import CSV files into Excel, in the same workbook.

Here is one I found that is quite clean, but I'm having a hard time inserting a header into it.

Option Explicit
Sub CSV()
Dim FilesToOpen As Variant
Dim x As Integer
Dim wkbTemp As Workbook
Dim iCtr As Long
Dim sFileName As String

Application.ScreenUpdating = False

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files, *.csv", _
MultiSelect:=True, Title:="Text Files to Open")

If IsArray(FilesToOpen) = False Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If

For iCtr = LBound(FilesToOpen) To UBound(FilesToOpen)
Workbooks.OpenText Filename:=FilesToOpen(iCtr), _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, _
Comma:=True, Space:=True, Other:=False

Set wkbTemp = ActiveWorkbook
sFileName = Left(wkbTemp.Name, (Len(wkbTemp.Name) - 22))
MsgBox sFileName

wkbTemp.Worksheets(1).Copy _
After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)


wkbTemp.Close savechanges:=False

Next iCtr

ExitHandler:
Application.ScreenUpdating = True
Set wkbTemp = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub


Now this does what I like it to do. What I also want is it to insert Headings into each based on a case statement.

I think its something like this to insert a row for the headings.

wkbAll.Worksheets(x).Range("A1").Select
Selection.EntireRow.Insert shift:=x1Down


Then this is what I have so far for The case statement:

Select Case sFileName
Case "Call Counts Report By Day"
wkbAll.Worksheets(x).Range("A1") = "Calls"
wkbAll.Worksheets(x).Range("B1") = "Period"

Case "Call Counts Report By Hour"
wkbAll.Worksheets(x).Range("A1") = "Calls"
wkbAll.Worksheets(x).Range("B1") = "Period"

Case "Call Detail Report By Call"
wkbAll.Worksheets(x).Range("A1") = "Call Id"
wkbAll.Worksheets(x).Range("B1") = "Channel Program"
wkbAll.Worksheets(x).Range("C1") = "Status Event"
wkbAll.Worksheets(x).Range("D1") = "Time"
End Select


So in Summary I want this VBA Macro to prompt me to select multiple .csv files and then import them into a single workbook. It will insert a row and add customized headers depending on the filename. I intend to run this every week and the filenames will only change by the last 22 numbers (the date).

I also found this code that works, but it doesn't allow me to select them all at once, I would have to run this program one at a time. Any help or direction would be amazing.


This is what I originally Had:

Sub CSV()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String
Dim sFileName As String


On Error GoTo ErrHandler
Application.ScreenUpdating = False

sDelimiter = ","

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Csv Files (*.csv), *.csv", _
MultiSelect:=True, Title:="Text Files to Open")

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If

x = 1

Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
wkbTemp.Sheets(1).Copy


' Get file title
Set wkbAll = ActiveWorkbook
sFileName = Left(wkbTemp.Name, (Len(wkbTemp.Name) - 22))
MsgBox sFileName

wkbTemp.Close (False)
wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=True, Space:=False, _
Other:=True
wkbAll.Worksheets(x).Range("A1").Select
Selection.EntireRow.Insert shift:=x1Down



' Place code here to check the name of the worksheet and
' put the proper column headers in row 1



Select Case sFileName
Case "Call Counts Report By Day"
wkbAll.Worksheets(x).Range("A1") = "Calls"
wkbAll.Worksheets(x).Range("B1") = "Period"

Case "Call Counts Report By Hour"
wkbAll.Worksheets(x).Range("A1") = "Calls"
wkbAll.Worksheets(x).Range("B1") = "Period"

Case "Call Detail Report By Call"
wkbAll.Worksheets(x).Range("A1") = "Call Id"
wkbAll.Worksheets(x).Range("B1") = "Channel Program"
wkbAll.Worksheets(x).Range("C1") = "Status Event"
wkbAll.Worksheets(x).Range("D1") = "Time"
End Select

x = x + 1

While x <= UBound(FilesToOpen)
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
With wkbAll
wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=True, Space:=False, _
Other:=True
.Worksheets(x).Range("A1").Select
End With
Selection.EntireRow.Insert shift:=x1Down
x = x + 1

Wend

ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Set wkbTemp = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub


Then I Altered it see what would happend:


Sub CSV()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String
Dim sFileName As String


On Error GoTo ErrHandler
Application.ScreenUpdating = False

sDelimiter = ","

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Csv Files (*.csv), *.csv", _
MultiSelect:=True, Title:="Text Files to Open")

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If

x = 1

Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
wkbTemp.Sheets(x).Copy


' Get file title
Set wkbAll = ActiveWorkbook
sFileName = Left(wkbTemp.Name, (Len(wkbTemp.Name) - 22))
' MsgBox sFileName

wkbTemp.Close (False)
wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=True, Space:=False, _
Other:=True
wkbAll.Worksheets(x).Range("A1").Select
Selection.EntireRow.Insert shift:=x1Down



' Place code here to check the name of the worksheet and
' put the proper column headers in row 1



Select Case sFileName
Case "Call Counts Report By Day"
wkbAll.Worksheets(x).Range("A1") = "Calls"
wkbAll.Worksheets(x).Range("B1") = "Period"

Case "Call Counts Report By Hour"
wkbAll.Worksheets(x).Range("A1") = "Calls"
wkbAll.Worksheets(x).Range("B1") = "Period"

Case "Call Detail Report By Call"
wkbAll.Worksheets(x).Range("A1") = "Call Id"
wkbAll.Worksheets(x).Range("B1") = "Channel Program"
wkbAll.Worksheets(x).Range("C1") = "Status Event"
wkbAll.Worksheets(x).Range("D1") = "Time"
End Select

x = x + 1



While x <= UBound(FilesToOpen)
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
sFileName = Left(wkbTemp.Name, (Len(wkbTemp.Name) - 22))
' MsgBox sFileName
' Set wkbAll = ActiveWorkbook
' wkbTemp.Sheets(x).Copy

With wkbAll
wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=True, Space:=False, _
Other:=True
.Worksheets(x).Range("A1").Select
End With
Selection.EntireRow.Insert shift:=x1Down

Select Case sFileName
Case "Call Counts Report By Day"
wkbAll.Worksheets(x).Range("A1") = "Calls"
wkbAll.Worksheets(x).Range("B1") = "Period"

Case "Call Counts Report By Hour"
wkbAll.Worksheets(x).Range("A1") = "Calls"
wkbAll.Worksheets(x).Range("B1") = "Period"

Case "Call Detail Report By Call"
wkbAll.Worksheets(x).Range("A1") = "Call Id"
wkbAll.Worksheets(x).Range("B1") = "Channel Program"
wkbAll.Worksheets(x).Range("C1") = "Status Event"
wkbAll.Worksheets(x).Range("D1") = "Time"
End Select

x = x + 1
Wend

ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Set wkbTemp = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub


The first codes logic is much clearer.

 

[SkipVought]

Hi,

Why not simply use the Data > Import feature?

NO VBA REQUIRED!

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Ifutant]

I want to use VBA due to the fact that I have multiple csv files and its a bit tedious to use the data import feature for each of these csv files. I would like to automate as much as possible.

 

[Ifutant]

I have the following Code.

Option Explicit
Sub csv()
Dim FilesToOpen As Variant
Dim x As Integer
Dim wkbTemp As Workbook
Dim iCtr As Long
Dim sFileName As String

Application.ScreenUpdating = False

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files, *.csv", _
MultiSelect:=True, Title:="Text Files to Open")

If IsArray(FilesToOpen) = False Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If

For iCtr = LBound(FilesToOpen) To UBound(FilesToOpen)
    Workbooks.OpenText Filename:=FilesToOpen(iCtr), _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, _
        Comma:=True, Space:=True, Other:=False

Selection.EntireRow.Insert shift:=x
    Set wkbTemp = ActiveWorkbook
    sFileName = Left(wkbTemp.Name, (Len(wkbTemp.Name) - 22))
    MsgBox sFileName
    
Columns("A:E").ColumnWidth = 30

    wkbTemp.Worksheets(1).Copy _
        After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
 

            
    wkbTemp.Close savechanges:=False

Next iCtr
       
ExitHandler:
Application.ScreenUpdating = True
Set wkbTemp = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

How do I use a case study like this to insert customized headers into each of the sheets?

 Select Case sFileName
        Case "Call Counts Report By Day"
                wkbAll.Worksheets(x).Range("A1") = "Calls"
                wkbAll.Worksheets(x).Range("B1") = "Period"
        
        Case "Call Counts Report By Hour"
                wkbAll.Worksheets(x).Range("A1") = "Calls"
                wkbAll.Worksheets(x).Range("B1") = "Period"
         
        Case "Call Detail Report By Call"
                wkbAll.Worksheets(x).Range("A1") = "Call Id"
                wkbAll.Worksheets(x).Range("B1") = "Channel Program"
                wkbAll.Worksheets(x).Range("C1") = "Status Event"
                wkbAll.Worksheets(x).Range("D1") = "Time"
    End Select

 

[SkipVought]

Turn on your macro recorder and record doing an import.

Modify as required.

Is this sheet1 imports file1, sheet2 imports file2... etc. and this import occurs periodically? If so, its a PERFECT application for such the Data > Import feature. Set up the initial imports and run REFRESH automatically as needed.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Ifutant]

That would work, but we want histroical data so that we can compare all in one worksheet.

So by your suggestion ie. refreshing the data you still have to go one by one and refresh the data.

We would rather to have a bunch of sheets all in one workbook that is labeled and easy to compare over previous weeks.

 

[SkipVought]

It could be a simple as this:

1. table that lists each .csv file

2. on sheet for import

3. a sheet corresponding to each .csv file

Do Loop thru the table

assign the file to the .Connection property

execute the query

copy the data in the .resultrange

paste the data in the next available row in the corresponding sheet

LOOP

On HUGE drawback with Opening text files directly with Excel, as opposed to IMPORT, is that you have no control over ANY data conversions that Excel makes, without your permission, under certain circumstances. Using IMPORT allows you to make those determinations or not.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Ifutant]

I appreciate the suggestions Skip, but my main concern is to find a way to use a case study to evaluate the sfilename and then according to the sfilename insert customized headings.

 

[SkipVought]

So your .csv files have no headings?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[HughLerwill]

Nice things about import/ QueryTables vs Open Text;

You can import directly into a selected Sheet and specify the row, col where you want to import to start. You can only Open into a new Workbook which means you have a lot of copying to do when you want the contents of many csvs to appear as sheets in a single Workbook.

When you import any formatting on the Sheet remains intact so you could import into a Template (.xlt) which aleady contains the required sheets, headers and column formats.

Import is very much quicker when you have to 'Open' a number of csv files.

 

[Ifutant]

Thanks for the Input. I actually figured out the problem, I had to tinker with the range. Now the vba script allows me to input as many csv files into one workbook. Upon importing, it automatically evaluates the filename and according to the case statement I created it assigns the correct formatting and headers for each worksheet. AWESOME!