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