You are here:

Excel/Manipulating multiple .csv files, importing, sorting, combining

Advertisement


Question
I read a similar question answered by you back in January 2009.
The original question was about importing/appending multiple text files using VBA/Excel.
I need to take it a few steps further. Once I import the file(s) (.csv in this case), I need it delimited (semicolon), then sorted descending on column "C", delete the remaining rows below row 1, then append the next file in the same manner. I have 569 files.
I am using Excel 2000. Each file does not exceed 65501 rows.

I recorded a macro of my procedure, then added code from your 2009 answer. Could you please tell me if I got it right?


Sub ImportCSV_Delimited()
'
' ImportCSV_Delimited Macro
' Macro recorded  by JPB
'

'
 Dim sh As Worksheet, sPath As String, sName As String
Dim r As Range, fName As String
Dim sh1 As Worksheet
With ThisWorkbook
 .Worksheets.Add After:=.Worksheets(.Worksheets.Count)
End With
Set sh = ActiveSheet
With ThisWorkbook
 .Worksheets.Add After:=.Worksheets(.Worksheets.Count)
End With
Set sh1 = ActiveSheet
sPath = "C:\KSP_win\GIS\Kerbin\Kerbin_elevation.csv_Pieces\"
' sPath = "C:\KSP_win\GIS\Kerbin\Test1\"
  
   sName = Dir(sPath & "*.txt")
Do While sName <> ""
sh1.Activate
fName = sPath & sName
   sh1.Cells.ClearContents
   With sh1.QueryTables.Add( _
      Connection:="TEXT;" & fName, _
       Destination:=sh1.Range("$A$1"))
   
       .FieldNames = True
       .RowNumbers = False
       .FillAdjacentFormulas = False
       .PreserveFormatting = True
       .RefreshOnFileOpen = False
       .RefreshStyle = xlInsertDeleteCells
       .SavePassword = False
       .SaveData = True
       .AdjustColumnWidth = True
       .RefreshPeriod = 0
       .TextFilePromptOnRefresh = False
       .TextFilePlatform = xlWindows
       .TextFileStartRow = 1
       .TextFileParseType = xlDelimited
       .TextFileTextQualifier = xlTextQualifierDoubleQuote
       .TextFileConsecutiveDelimiter = False
       .TextFileTabDelimiter = False
       .TextFileSemicolonDelimiter = True
       .TextFileCommaDelimiter = False
       .TextFileSpaceDelimiter = False
       .TextFileColumnDataTypes = Array(1, 1, 1)
       .Refresh BackgroundQuery:=False
   End With
   Cells.Select
   Selection.Sort Key1:=Range("C1"), Order1:=xlDescending, Header:=xlGuess, _
       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
   Rows("62675:65501").Select
   Range("A65501").Activate
   Rows("2:65501").Select
   Range("A65501").Activate
   Selection.ClearContents
   Range("A1").Select
   
Set r = sh.Cells(Rows.Count, 1).End(xlUp)
If r.Value <> "" Then Set r = r(2)
sh1.Range("A1").CurrentRegion.Copy
r.PasteSpecial xlValue
sName = Dir()
Loop
Application.DisplayAlerts = False
 sh1.Delete
Application.DisplayAlerts = True
   
   ActiveWorkbook.SaveAs Filename:= _
       "C:\KSP_win\GIS\Kerbin\Test1\Kerbin_elevation_peaks_master.xls" _
       , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
       ReadOnlyRecommended:=False, CreateBackup:=False

End Sub


Best Regards,

John

Answer
John,
as I understand your description, you want to copy row 1 from the scratch sheet (sh1) after you sort the data descending on column C.  What is somewhat confusing is whether you have a header or not or if you do, you are assuming it will be sorted out of row 1.  

Given those assumptions I would modify your code to:

Sub ImportCSV_Delimited()
'
' ImportCSV_Delimited Macro
' Macro recorded  by JPB
'

'
 Dim sh As Worksheet, sPath As String, sName As String
Dim r As Range, fName As String
Dim sh1 As Worksheet
With ThisWorkbook
 .Worksheets.Add After:=.Worksheets(.Worksheets.Count)
End With
Set sh = ActiveSheet
With ThisWorkbook
 .Worksheets.Add After:=.Worksheets(.Worksheets.Count)
End With
Set sh1 = ActiveSheet
sPath = "C:\KSP_win\GIS\Kerbin\Kerbin_elevation.csv_Pieces\"
' sPath = "C:\KSP_win\GIS\Kerbin\Test1\"
  
   sName = Dir(sPath & "*.txt")
Do While sName <> ""
sh1.Activate
fName = sPath & sName
   sh1.Cells.ClearContents
   With sh1.QueryTables.Add( _
      Connection:="TEXT;" & fName, _
       Destination:=sh1.Range("$A$1"))
   
       .FieldNames = True
       .RowNumbers = False
       .FillAdjacentFormulas = False
       .PreserveFormatting = True
       .RefreshOnFileOpen = False
       .RefreshStyle = xlInsertDeleteCells
       .SavePassword = False
       .SaveData = True
       .AdjustColumnWidth = True
       .RefreshPeriod = 0
       .TextFilePromptOnRefresh = False
       .TextFilePlatform = xlWindows
       .TextFileStartRow = 1
       .TextFileParseType = xlDelimited
       .TextFileTextQualifier = xlTextQualifierDoubleQuote
       .TextFileConsecutiveDelimiter = False
       .TextFileTabDelimiter = False
       .TextFileSemicolonDelimiter = True
       .TextFileCommaDelimiter = False
       .TextFileSpaceDelimiter = False
       .TextFileColumnDataTypes = Array(1, 1, 1)
       .Refresh BackgroundQuery:=False
   End With
   Cells.Select
   Cells.copy
' I changed the header argument to xlNo.  But I am guessing at your data layout.
   Selection.Sort Key1:=Range("C1"), Order1:=xlDescending, Header:=xlNo, _
       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    
Set r = sh.Cells(Rows.Count, 1).End(xlUp)
If r.Value <> "" Then Set r = r(2)
sh1.rows(1).Copy  ' copy just the top row
r.PasteSpecial xlValues  '<== changed the constant
sName = Dir()
Loop
Application.DisplayAlerts = False
 sh1.Delete
Application.DisplayAlerts = True
   
   ActiveWorkbook.SaveAs Filename:= _
       "C:\KSP_win\GIS\Kerbin\Test1\Kerbin_elevation_peaks_master.xls" _
       , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
       ReadOnlyRecommended:=False, CreateBackup:=False

End Sub

I would point the macro to a directory with only a few files for testing and see if this does what you want.

--
Regards,
Tom Ogilyv

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.