Make macro faster/more efficient?

[davidwilsontpe]

I have a macro which basically takes a csv file, performs some cleansing operations on it and then saves it as a new .xls file into a format that can be read directly by another program.

The current macro I use works fine and has served me well for a long time. However, it takes about 15-20 minutes to run the macro on approx 3,000 csv files.

Is there anything more I can do to make this macro more efficient/run faster?

The original csv file I am cleansing is as per: chartapi.finance.yahoo.com/instrument/1.0/0001.HK/chartdata;type=quote;range=1d/csv/

and the current macro I am using to cleanse the data is as below. Any help would be most appreciated because by knowing how to do this, I will be able to take my knowledge of macros to a higher level:

Sub cleanse_files()

'Figures out if there is data on the csv, if not, then close it and move on to the next file, otherwise cleanse the data.
If Range("a19").Value = "" Or Range("f18").Value = "0" And Range("a19").Value = "" Then
ActiveWorkbook.Close False

Else
Application.Calculation = xlCalculationManual

'Count the number of rows
lastrow = ActiveSheet.UsedRange.Rows.Count

'Insert 3 columns on left
Columns("A:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

'put a formula in to convert the unix date and time into a proper format
Range("b18").FormulaR1C1 = "=(RC[2]/86400)+25569+(8/24)"

'Now put the date into all the rows as values
Range("b18:b" & lastrow).Value = Range("b18").Value

'Copy the time formula down to the last row in column c
Range("c18:c" & lastrow).FormulaR1C1 = "=(RC[1]/86400)+25569+(8/24)"


'put a formula into cell a1 which will reveal the stock ticker symbol
Range("A1").FormulaR1C1 = _
"=IF(ISNUMBER(SEARCH(""*T.T"",RC[3])),MID(RC[3],21,LEN(RC[3])-68),IF(ISNUMBER(SEARCH(""*.TWO*"",RC[3])),MID(RC[3],21,LEN(RC[3])-67),MID(RC[3],21,LEN(RC[3])-66)))"

'now copy and paste the ticker symbol down to the last row in col a
Range("a1:a" & lastrow).Value = Range("A1").Value

'put a new time and date formula into cols K and L as text format
Range("K18").FormulaR1C1 = "=TEXT(RC[-9],""mm/dd/yyyy"")"
Range("L18").FormulaR1C1 = "=TEXT(RC[-9],""hh:mm:ss"")"

'now pull those formulas down to the last low in cols k and l
Range("k18").AutoFill Destination:=Range("k18:k" & lastrow)
Range("l18").AutoFill Destination:=Range("l18:l" & lastrow)

'now delete rows 2-17
Rows("2:17").Delete Shift:=xlUp

'Now put the header titles in
Range("a1").Value = "TICKER"
Range("e1").Value = "OPEN"
Range("f1").Value = "HIGH"
Range("g1").Value = "LOW"
Range("h1").Value = "CLOSE"
Range("i1").Value = "VOLUME"
Range("k1").Value = "DATE"
Range("l1").Value = "TIME"

'Now update the formulas
Application.Calculation = xlCalculationAutomatic

'Tale the formulas in cols K and L and copy and paste them as value
Columns("K:L").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Now cut cols K and L and put them in cols B and C
Columns("K:L").Cut Destination:=Columns("B:C")

'delete the old unix data and time column
Columns("D:D").Delete Shift:=xlToLeft

'Now save the file giving it the name of the tickersymbol in cell A2 followed by .xls
ThisFile = Range("a2").Value & ".XLS"
ActiveWorkbook.SaveAs "C:\Users\David\Desktop\cleansed_files\" & ThisFile _
, FileFormat:=xlExcel8, CreateBackup:=False, Local:=True

Application.DisplayAlerts = False
ActiveWindow.Close
End If
End Sub

 

[ukmikeb]

Hi

I would be inclined to recalculate the lastrow before copying/pasting and cutting Columns K and L on the basis you are unlikely to be using the 1 million plus rows.

hth

 

[davidwilsontpe]

Thanks for the comments and for taking the time to look through my code. I will change it as per your suggestion... but I'm just curious why I would need it to recalculate the last row if it has already figured out what the last row is earlier on. What would make it think that the lastrow has since been extended? Cheers!

Hi

I would be inclined to recalculate the lastrow before copying/pasting and cutting Columns K and L on the basis you are unlikely to be using the 1 million plus rows.

hth

 

[davidwilsontpe]

..Or is it because I am cutting the entire column, rather than cutting a fixed range?

 

[ukmikeb]

Hi

You don't need the Select, so you could change this code :-

'Tale the formulas in cols K and L and copy and paste them as value
Columns("K:L").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Now cut cols K and L and put them in cols B and C
Columns("K:L").Cut Destination:=Columns("B:C")

to this :-

'Tale the formulas in cols K and L and copy and paste them as value
Range("K1:L" & lastrow).Copy
Range("K1:L" & lastrow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Now cut cols K and L and put them in cols B and C
Range("K1:L" & lastrow).Cut Destination:=Range("B1:C" & lastrow)

or you might even able to get by with this :-

'Tale the formulas in cols K and L and copy and paste them as value
With Range("K1:L" & lastrow)
      .Copy
      .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Application.CutCopyMode = False


'Now cut cols K and L and put them in cols B and C
Range("K1:L" & lastrow).Cut Destination:=Range("B1:C" & lastrow)

On reflection it won't matter using the existing value of lastrow, only 16 rows of nulls as opposed to hundreds of thousands.

Also, not that it would affect the timing change the test at the beginning of the module to :-

'Figures out if there is data on the csv, if not, then close it and move on to the next file, otherwise cleanse the data.
If Range("a19").Value = "" Or Range("f18").Value = "0" And Range("a19").Value = "" Then
     ActiveWorkbook.Close False
     Exit Sub
End If

and remove the "Else" prior to your main code and the "End If" near the end of the module.


hth

 

[davidwilsontpe]

Thanks a lot Mike.. I've made all the changes you suggested and they all work ok. I did a 'before and after' test on 1,600 files because I was really curious to see how even the smallest of changes can speed things up.

Before: 5m 30s
After: 5m 10s

So you managed to shave off 20 seconds.. which is just over 6%, so even though its fairly small, I am grateful to you many times larger! -Cheers!

Hi

You don't need the Select, so you could change this code :-

'Tale the formulas in cols K and L and copy and paste them as value
Columns("K:L").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Now cut cols K and L and put them in cols B and C
Columns("K:L").Cut Destination:=Columns("B:C")

to this :-

'Tale the formulas in cols K and L and copy and paste them as value
Range("K1:L" & lastrow).Copy
Range("K1:L" & lastrow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Now cut cols K and L and put them in cols B and C
Range("K1:L" & lastrow).Cut Destination:=Range("B1:C" & lastrow)

or you might even able to get by with this :-

'Tale the formulas in cols K and L and copy and paste them as value
With Range("K1:L" & lastrow)
      .Copy
      .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Application.CutCopyMode = False


'Now cut cols K and L and put them in cols B and C
Range("K1:L" & lastrow).Cut Destination:=Range("B1:C" & lastrow)

On reflection it won't matter using the existing value of lastrow, only 16 rows of nulls as opposed to hundreds of thousands.

Also, not that it would affect the timing change the test at the beginning of the module to :-

'Figures out if there is data on the csv, if not, then close it and move on to the next file, otherwise cleanse the data.
If Range("a19").Value = "" Or Range("f18").Value = "0" And Range("a19").Value = "" Then
     ActiveWorkbook.Close False
     Exit Sub
End If

and remove the "Else" prior to your main code and the "End If" near the end of the module.


hth

 

[ukmikeb]

Hi

That's quite a welcome improvement!

One further point you could change the Formula assignments (A, B K and L) to cater for the whole range as you currently have for Column C.

Pleased to have helped you solve your problem.

Good luck with your project.