#1
|
|||
|
|||
Convert csv document to excel, format date
Dear Forum,
I am a novice creating macros. I would like to refine my macro as it is too long and I am sure it can be much better. The macro should: 1) convert a csv document to excel 2) insert two columns one for a date format and another for a number of rows 3) to delete the empty rows 4) the rows vary, how can I define it better, sometimes is only up to row 30, sometimes to row 60, etc... example file, (the real file has many columns and rows): Date,"Name" 20151231,"ate at restaurant" 20151231,"bought something" My macro is like this: Sub ConvertToTable() ' 'convert text to table ' Range("A:A").Select Selection.Copy ExecuteExcel4Macro "WINDOW.SIZE(398,53,"""")" ExecuteExcel4Macro "WINDOW.MOVE(2,-43,"""")" Workbooks.Add ActiveSheet.Paste Application.CutCopyMode = False Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :="""", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 9), Array(4, 1), Array(5 _ , 9), Array(6, 1), Array(7, 9), Array(8, 1), Array(9, 9), Array(10, 1), Array(11, 9), Array( _ 12, 1), Array(13, 9), Array(14, 1), Array(15, 9), Array(16, 1), Array(17, 1)) Range("A2").Select Selection.EntireColumn.Insert Selection.EntireColumn.Insert ' add to columns date Range("B1").Select ActiveCell.FormulaR1C1 = "Date2" Range("B2").Select ActiveWindow.SmallScroll ToRight:=6 ActiveCell.FormulaR1C1 = _ "=IF(RC[1]<>"""",(DATE(LEFT(RC[1],4),VALUE(MID(RC[1],5,2)),RIGHT(RC[1],2))),"" "")" Range("B2").Select Selection.NumberFormat = "dd-mmm-yy" Selection.AutoFill Destination:=Range("B2:B100") Range("B1:B100").Select ActiveWindow.LargeScroll Down:=1 Range("B1:B100").Select ActiveWorkbook.Worksheets("Blad1").Sort.SortFields .Clear ActiveWorkbook.Worksheets("Blad1").Sort.SortFields .Add Key:=Range("B1"), _ SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Blad1").Sort .SetRange Range("B2:K100") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' sort by date Range("B1:M107").Select ActiveWindow.ScrollRow = 1 ActiveWorkbook.Worksheets("Blad1").Sort.SortFields .Clear ActiveWorkbook.Worksheets("Blad1").Sort.SortFields .Add Key:=Range("B1"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Blad1").Sort .SetRange Range("B2:L100") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' add to columns number from 1 forward Range("A1").Select ActiveCell.FormulaR1C1 = "no" Range("A2").Select ActiveCell.FormulaR1C1 = "1" Range("A3").Select ActiveCell.FormulaR1C1 = "2" Range("A3").Select ActiveCell.FormulaR1C1 = "=R[-1]C+1" Range("A3").Select Selection.AutoFill Destination:=Range("A3:A100") Range("A3:A61").Select ActiveWindow.SmallScroll Down:=-63 Range("A2").Select 'delete empy rows On Error Resume Next Application.ScreenUpdating = False Columns("D").SpecialCells(xlCellTypeBlanks).Enti reRow.Delete Application.ScreenUpdating = True End Sub Thanks for your help. Coba |
#2
|
|||
|
|||
Dear CB-expert,
I would really appreciate feedback |
#3
|
||||
|
||||
Perhaps this:
Code:
Sub ConvertToTable() ' 'convert text to table ' Dim LastRow As Long Dim ws As Worksheet Application.ScreenUpdating = False Range("A:A").Copy Workbooks.Add Set ws = ActiveSheet With ws .Paste Application.CutCopyMode = False Selection.TextToColumns Destination:=ws.Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="""", _ FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 9), Array(4, 1), Array(5, 9), _ Array(6, 1), Array(7, 9), Array(8, 1), Array(9, 9), Array(10, 1), Array(11, 9), _ Array(12, 1), Array(13, 9), Array(14, 1), Array(15, 9), Array(16, 1), Array(17, 1)) .Range("A:B").EntireColumn.Insert LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row ' add to columns date .Range("B1").Value2 = "Date2" With .Range("B2:B" & LastRow) .FormulaR1C1 = "=IF(RC[1]<>"""",TEXT(RC[1],""0000-00-00"")+0,"""")" .NumberFormat = "dd-mmm-yy" End With With .Sort With .SortFields .Clear .Add Key:=ws.Range("B1"), SortOn:=xlSortOnValues, _ Order:=xlAscending, DataOption:=xlSortNormal End With .SetRange ws.Range("B2:L100") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' add to columns number from 1 forward .Range("A1").Value2 = "no" With .Range("A2") .Value2 = 1 .AutoFill Destination:=ws.Range("A2:A" & LastRow), Type:=xlFillSeries End With 'delete empty rows On Error Resume Next .Columns("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete Application.ScreenUpdating = True End With End Sub |
#4
|
|||
|
|||
Thank you very much.
It looks more professional now coba Last edited by coba; 01-07-2016 at 04:23 AM. Reason: Solved |
Tags |
convert text to column, excel-vba |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Convert text to date format | klllmmm | Excel | 5 | 11-16-2015 07:02 AM |
Letter date changes when merging with Excel - not the format, the actual date! | Smallweed | Mail Merge | 1 | 02-07-2014 06:00 PM |
Document properties in word - date format | Chieps | Word | 8 | 09-26-2013 11:37 PM |
Excel formula from looking the base date and convert into desire result | PRADEEPB270 | Excel | 1 | 02-17-2013 03:11 AM |
Excel convert format [h]:mm:ss to decimal | gchan2000 | Excel | 1 | 08-17-2010 01:36 PM |