Can Anyone Help Speed Up My Macro?

[smcmahon83]

Hi everyone,

I have the following macro and heard that if you bypass using the clipboard, it can speed things up. Can someone please take a look at my macro below and change anything that you think will make it more efficient? Many thanks to anyone who can help.

Sub Formatter()
'
' Formatter Macro
'
    Do Until IsEmpty(ActiveCell)
    Range("L3:AX3").Select
    Selection.Copy
    Range("L4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B15").Select
    Selection.Delete Shift:=xlUp
    Range("B9").Select
    ActiveCell.FormulaR1C1 = "=R[6]C"
    Range("B15").Select

Call GetData
Call DeleteNamedRanges
Loop
End Sub

[gmr4evr1]

This doesn't address the clipboard part, but, try adding this after Sub Formatter()

Application.ScreenUpdating = False
Application.Calculation = xlManual

And this before End Sub

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True

This may help speed things up a bit.

[smcmahon83]

Thanks, Gmr. That did speed things up a bit.

If anyone has any other modifications that can increase speed, please let me know.

[jaslake]

Hi smcmahon83

You're doing unnecessary Selecting. One rarely needs to Select in Code.

Please post the rest of your Code, particularly these and I'll look at it.

Call GetData
Call DeleteNamedRanges

[gmr4evr1]

smcmahon,
Glad it helped a bit.
As for what John said.....I knew that using Select wasn't good, I just didn't know how to correct it for OP so I decided to not say anything about, I had hoped that someone else would. Thanks John

[smcmahon83]

Thank you both John and Gmr for you willingness to help.

John, the first macro being called upon is below. In short, it pulls data from a website and pastes it into a nested table within Excel. There is a lot of code to work with time format conversions.

Sub GetData()
    Dim ParameterSheet As Worksheet
    Dim DataSheet As Worksheet
    Dim ticker As String
    Dim exchange As String
    Dim interval As Integer
    Dim numPastTradingDays As Integer
    Dim qurl As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

    Set ParameterSheet = Sheets("Parameters")
    Set DataSheet = Sheets("Data")

    DataSheet.Cells.Clear
    ticker = ParameterSheet.Range("ticker").Value
    exchange = ParameterSheet.Range("exchange").Value
    interval = ParameterSheet.Range("interval").Value
    numPastTradingDays = ParameterSheet.Range("numTradingDays").Value

    qurl = "http://www.google.com/finance/getprices?" & _
           "q=" & ticker & _
           "&i=" & interval & _
           "&p=" & numPastTradingDays & "d" & _
           "&f=d,o,h,l,c,v"

QueryQuote:
    With DataSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("a1"))
        .BackgroundQuery = True
        .TablesOnlyFromHTML = False
        .Refresh BackgroundQuery:=False
        .SaveData = True
    End With

    DataSheet.Range("a1").CurrentRegion.TextToColumns Destination:=DataSheet.Range("a1"), DataType:=xlDelimited, _
                                                      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                                                      Semicolon:=False, Comma:=True, Space:=False, other:=False

    DataSheet.Columns("A:G").ColumnWidth = 12

    '===Convert Google timestamp to Excel timestamp (only for Windows)
    Dim timeStamp As Double
    Dim timeStampRaw As String
    Dim timeZoneOffsetRaw As String
    Dim timeZoneOffset As Variant
    Dim numRows As Integer
    Dim i As Integer
    numRows = DataSheet.UsedRange.Rows.Count - 1

    timeZoneOffsetRaw = DataSheet.Range("a7")
    timeZoneOffset = (Mid(timeZoneOffsetRaw, InStr(timeZoneOffsetRaw, "=") + 1, 10))

    For i = 8 To numRows

        If Not IsNumeric(DataSheet.Range("a" & i)) Then

            timeStampRaw = DataSheet.Range("a" & i)
            timeStamp = (Mid(timeStampRaw, 2, Len(timeStampRaw) - 1))
            timeStamp = (timeStamp + timeZoneOffset * 60)
            DataSheet.Range("g" & i) = timeStamp / 86400 + 25569

        Else

            DataSheet.Range("g" & i).FormulaR1C1 = "=(RC[-6]*" & interval & "+" & timeStamp & ")/86400+25569"

        End If

    Next

    DataSheet.Range("g8:g" & numRows).NumberFormat = "d mmm yyyy h:mm;@"
    DataSheet.Range("G:G").Columns.AutoFit

    Application.Calculation = xlCalculationAutomatic

End Sub

The second macro being called upon is below. All this macro does is delete these pesky "named ranges" that get created every time the code above runs. So if you run the getdata macro 500 times, 500 named ranges will being created, without this deleter macro.

Public Sub DeleteNamedRanges()
  Dim NamedRange As Name
  
  For Each NamedRange In ThisWorkbook.Names
    If InStr(NamedRange.Name, "External") > 0 Then NamedRange.Delete
  Next
End Sub

The formatter macro that I included in my original post, essentially runs the web query using the 'getdata' macro, takes data as it appears in row 1, pastes it to row 2, and inserts a row above the row it just pasted (to keep pushing the pasted data down as the loop runs). Once this is complete, the formatter macro deletes the value in cell C15 (keyword used for web query) and shifts up so the keyword in C16 will appear in C15, (as this is the active cell constantly being used to fetch data by the web query). I hope this makes some sense, and if you can help at all I would be much obliged. Thanks.