Importing CSV data sorted by date into Excel
Posted by Ed Cupstid on January 27, 2002 6:56 PM
I have an Excel macro that imports CSV data into a worksheet. The CSV data is sorted by date, is it possible to have logic in the macro that would start the import into sheet1 then when the date in the data changes rename the current sheet using the date in A1 as the name then start a new sheet before importing the first record with the new date....etc. Resulting in a workbook with sheets of data (named from the date of the data imported to each from the single CSV file)sorted by date. If anyone has done this and could provide enough information(sample code) to get me started, it would be greatly appreciated.
Posted by Barrie Davidson on January 27, 2002 7:31 PM
What column is the date in when you import the CSV file? How many columns are you using in total?
BarrieBarrie Davidson
Posted by Bariloche on January 27, 2002 8:08 PM
Ed,
When you import data it comes in all at once (essentially). You can't "interupt" the import and put some of the data on one sheet and some on another. However, you can of course move the data once it gets in Excel. Is your data suitable for a Pivot Table? The reason that I ask is that the pivot table provides for a "Page Field" which can used to create one worksheet page for each item in the "page field." If you're not familiar with pivot tables read throught the Excel Help and see if they can be of any use to you. A pivot table might be the quickest way to get what you want.
have fun
Posted by Ed Cupstid on January 28, 2002 6:46 AM
Thanks for asking....there are 20 columns. The first row in the CSV contains a header. The date is always in column B starting in B2 (the records in the CSV file are sorted by date). If the records have to be moved to new sheets then the header record in sheet1 would also have to copied to the first row in each new sheet. Any help you can offer will be greatly appreciated.
Posted by Barrie Davidson on January 28, 2002 11:44 AM
Ed, try this code:
Sub ImportCSVFile()
' Macro written by Barrie Davidson
Dim Count As Long
Dim i As Long
Dim SheetName As String
Dim LastRow As Long
Dim LastColumn As Long
'Your code to open the CSV file
SheetName = ActiveSheet.Name
LastRow = Range("A1").End(xlDown).Row
LastColumn = Range("A1").End(xlToRight).Column
Range("A1").End(xlToRight).Offset(0, 1).Formula = "Header"
Range("A1").End(xlToRight).Offset(1, 0).Formula = "1"
Range(Range("A1").End(xlToRight).Offset(2, 0).Address, _
Range("A1").End(xlDown).End(xlToRight). _
Address).Formula _
= "=IF(RC[-" & LastColumn - 1 & "]=R[-1]C[-" & _
LastColumn - 1 & "],R[-1]C,R[-1]C+1)"
Count = Application.WorksheetFunction.Max( _
Range(Range("B1").End(xlToRight).Offset(2, 0).Address, _
Range("B1").End(xlDown).End(xlToRight). _
Address))
i = 1
Do Until i > Count
Range(Cells(1, 1), Cells(LastRow, (LastColumn + 1))).Select
Selection.AutoFilter Field:=Range("A1").End(xlToRight).Column, _
Criteria1:=i
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets.Add after:=ActiveSheet
ActiveSheet.Paste
Application.CutCopyMode = False
Range(Range("A1").End(xlToRight).Address, _
Range("A1").End(xlDown).End(xlToRight). _
Address).ClearContents
ActiveCell.Select
Sheets(SheetName).Select
i = i + 1
Loop
End Sub
Depending on whether you want to keep the original worksheet you create when opening the CSV file, you can add the following code just before the "End Sub" statement:
'This part keeps your original worksheet
Range(Cells(1, 1), Cells(LastRow, (LastColumn + 1))).AutoFilter
Range(Range("A1").End(xlToRight).Address, _
Range("A1").End(xlDown).End(xlToRight). _
Address).ClearContents
ActiveCell.Select
'This part deletes your original worksheet
Sheets(SheetName).Delete
Hope this is what you need.
Regards,
BarrieBarrie Davidson
Posted by Ed Cupstid on January 28, 2002 3:40 PM
Re: Barrie - almost there...just a couple of problems.
Barrie, thanks for the quick response and the code. I inserted the code into my macro and ran it...we are almost there. I am inserting the complete macro below with comments that explain the problems and where they occur. Your help is very much appreciated:
Sub Auto_Open()
'
' Macro recorded 1/17/2002 by Ed Cupstid
'
ChDir "d:\excel"
Workbooks.OpenText Filename:="d:\excel\generic.exc", Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
, Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 2 _
), Array(2, 2), Array(3, 2), Array(4, 1), Array(5, 2), Array(6, 2), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1))
'Macro written by Barrie Davidson and inserted here
Dim Count As Long
Dim i As Long
Dim SheetName As String
Dim LastRow As Long
Dim LastColumn As Long
'code to open the CSV file
SheetName = ActiveSheet.Name
LastRow = Range("A1").End(xlDown).Row
LastColumn = Range("A1").End(xlToRight).Column
Range("A1").End(xlToRight).Offset(0, 1).Formula = "Header"
Range("A1").End(xlToRight).Offset(1, 0).Formula = "1"
Range(Range("A1").End(xlToRight).Offset(2, 0).Address, _
Range("A1").End(xlDown).End(xlToRight). _
Address).Formula _
= "=IF(RC[-" & LastColumn - 1 & "]=R[-1]C[-" & _
LastColumn - 1 & "],R[-1]C,R[-1]C+1)"
Count = Application.WorksheetFunction.Max( _
Range(Range("B1").End(xlToRight).Offset(2, 0).Address, _
Range("B1").End(xlDown).End(xlToRight). _
Address))
i = 1
Do Until i > Count
Range(Cells(1, 1), Cells(LastRow, (LastColumn + 1))).Select
Selection.AutoFilter Field:=Range("A1").End(xlToRight).Column, _
Criteria1:=i
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets.Add after:=ActiveSheet
ActiveSheet.Paste
Application.CutCopyMode = False
Range(Range("A1").End(xlToRight).Address, _
Range("A1").End(xlDown).End(xlToRight). _
Address).ClearContents
ActiveCell.Select
Sheets(SheetName).Select
i = i + 1
Loop
'would like to automated the following line to automatically delete without user input.
Sheets(SheetName).Delete
'At this point there are two worksheets(there are only two dates in the CSV file), neither sheet
'has a header record in row 1 (the first record imported from the CSV file is the header record)
'Row1 (data with date in column B) from sheet1 is duplicated in row1 sheet2, otherwise the records
'are being being separated by date and parsed into the right sheet.
For i = 1 To Sheets.Count
'can not use the date as a sheet name because of the "/"
'have to figure out a way to translate "99/99/9999" date value in "B2"
'to "99999999" format
' ActiveSheet.Name = Range("B2").Value
'the following code is only formatting first sheet (sheet1)
'so when I figure out the above logic for naming the sheet it will most likely only
'name the first sheet....need help with this.
Rows("1:1").RowHeight = 24
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Columns("A:A").ColumnWidth = 12
Columns("B:B").ColumnWidth = 11
Columns("C:C").ColumnWidth = 11.29
Columns("D:D").ColumnWidth = 12
Columns("E:E").ColumnWidth = 12.43
Columns("F:F").ColumnWidth = 19.29
ActiveWindow.SmallScroll ToRight:=3
Columns("G:G").ColumnWidth = 15
Columns("H:H").ColumnWidth = 13.71
Columns("I:I").ColumnWidth = 14.71
ActiveWindow.SmallScroll ToRight:=2
Columns("J:J").ColumnWidth = 14
Columns("K:K").ColumnWidth = 15.14
ActiveWindow.SmallScroll ToRight:=3
Columns("M:M").ColumnWidth = 13.57
Columns("N:N").ColumnWidth = 13.14
ActiveWindow.SmallScroll ToRight:=3
Columns("P:P").ColumnWidth = 15.43
Columns("Q:Q").ColumnWidth = 13.86
ActiveWindow.SmallScroll ToRight:=5
Columns("R:R").ColumnWidth = 11.43
Columns("S:S").ColumnWidth = 11
Columns("T:T").ColumnWidth = 15
ActiveWindow.SmallScroll ToRight:=-3
Columns("O:O").ColumnWidth = 14.71
ActiveWindow.SmallScroll ToRight:=-2
Columns("M:T").Select
Selection.NumberFormat = "0.00"
Columns("D").Select
Selection.NumberFormat = "0.00"
Range("L16").Select
Columns("L:L").ColumnWidth = 15.57
ActiveWindow.ScrollColumn = 1
Rows("1:1").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Next i
'the following logic works
Range("A2").Select
ActiveWindow.ScrollColumn = 15
ActiveWindow.SmallScroll ToRight:=-14
ChDir "d:\excel"
ThisFile = "d:\excel\" + Range("A2").Value
ActiveWorkbook.SaveAs Filename:=ThisFile, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWorkbook.RunAutoMacros Which:=xlAutoClose
Dim Wb As Workbook
For Each Wb In Workbooks
If Wb.Name <> ThisWorkbook.Name Then
Wb.Close savechanges:=True
End If
Next Wb
Application.Quit
End Sub
Posted by Barrie Davidson on January 28, 2002 7:13 PM
Re: Barrie - almost there...just a couple of problems.
Ed, I made some changes to your code. Here it is:
Sub Auto_Open()
'
' Macro recorded 1/17/2002 by Ed Cupstid
'
ChDir "d:\excel"
Workbooks.OpenText FileName:="d:\excel\generic.exc", Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
, Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 2 _
), Array(2, 2), Array(3, 2), Array(4, 1), Array(5, 2), Array(6, 2), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1))
'Macro written by Barrie Davidson and inserted here
Dim Count As Long
Dim i As Long
Dim SheetName As String
Dim LastRow As Long
Dim LastColumn As Long
SheetName = ActiveSheet.Name
LastRow = Range("A1").End(xlDown).Row
LastColumn = Range("A1").End(xlToRight).Column
Range("A1").End(xlToRight).Offset(0, 1).Formula = "Header"
Range("A1").End(xlToRight).Offset(1, 0).Formula = "1"
Range(Range("A1").End(xlToRight).Offset(2, 0).Address, _
Range("A1").End(xlDown).End(xlToRight). _
Address).Formula _
= "=IF(RC[-" & LastColumn - 1 & "]=R[-1]C[-" & _
LastColumn - 1 & "],R[-1]C,R[-1]C+1)"
Count = Application.WorksheetFunction.Max( _
Range(Range("B1").End(xlToRight).Offset(2, 0).Address, _
Range("B1").End(xlDown).End(xlToRight). _
Address))
i = 1
Do Until i > Count
Range(Cells(1, 1), Cells(LastRow, (LastColumn + 1))).Select
Selection.AutoFilter Field:=Range("A1").End(xlToRight).Column, _
Criteria1:=i
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets.Add after:=ActiveSheet
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Select
Sheets(SheetName).Select
i = i + 1
Loop
Application.DisplayAlerts = False
Sheets(SheetName).Delete
Application.DisplayAlerts = True
For i = 1 To Sheets.Count
Sheets(i).Select
ActiveSheet.Name = Format(Range("B2").Value, "mm-dd-yyyy")
Rows("1:1").RowHeight = 24
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Columns("A:A").ColumnWidth = 12
Columns("B:B").ColumnWidth = 11
Columns("C:C").ColumnWidth = 11.29
Columns("D:D").ColumnWidth = 12
Columns("E:E").ColumnWidth = 12.43
Columns("F:F").ColumnWidth = 19.29
Columns("G:G").ColumnWidth = 15
Columns("H:H").ColumnWidth = 13.71
Columns("I:I").ColumnWidth = 14.71
Columns("J:J").ColumnWidth = 14
Columns("K:K").ColumnWidth = 15.14
Columns("M:M").ColumnWidth = 13.57
Columns("N:N").ColumnWidth = 13.14
Columns("P:P").ColumnWidth = 15.43
Columns("Q:Q").ColumnWidth = 13.86
Columns("R:R").ColumnWidth = 11.43
Columns("S:S").ColumnWidth = 11
Columns("T:T").ColumnWidth = 15
Columns("O:O").ColumnWidth = 14.71
Columns("M:T").Select
Selection.NumberFormat = "0.00"
Columns("D").Select
Selection.NumberFormat = "0.00"
Range("L16").Select
Columns("L:L").ColumnWidth = 15.57
Rows("1:1").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Next i
Range("A2").Select
ChDir "d:\excel"
ThisFile = "d:\excel\" + Range("A2").Value
ActiveWorkbook.SaveAs FileName:=ThisFile, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWorkbook.RunAutoMacros Which:=xlAutoClose
Dim Wb As Workbook
For Each Wb In Workbooks
If Wb.Name <> ThisWorkbook.Name Then
Wb.Close savechanges:=True
End If
Next Wb
Application.Quit
End Sub
I hope this will work out for you.
Regards,
Barrie
Barrie Davidson
Posted by Ed Cupstid on January 29, 2002 7:13 AM
Re: Barrie - almost there...just a couple of problems.
Barrie,
The new code resolved the header problem and the duplication of the one record across sheets and names the sheet using the mm-dd-yyyy format (I had already figured out how to format the date), and it resolved the formatting problem. However, the data in the last two columns (in all sheets) is not correct, and there is a "Header" column being created with a cell value in each of 1 for the first sheet, 2 for the second sheet...etc, would like to have this deleted someway before saving the file. Importing the CSV data creates columns A-T, then column U is being added with "Header" in U1. The cell values starting in row 2 for Columns S & T are wrong. The first "data" record in each sheet has a value of 5.00 in D2 and a cell value of 0.00 in all remaining cells in column D, this is correct. It appears that the cell value (5.00) in D2 is getting copied to all the cells in Column T2 down, and a value of 0.00 is over writting the correct value that should be in Column S2 down. I spent several hours last night trying to figure out what is causing this...but have failed. Hope I have explained the problem clearly enough for you. I know you must have better things to do than work on someone else's problem, but I really need and appreciate your help.
