Can my Macro run faster

GingaNinga

New Member
Joined
Sep 1, 2017
Messages
10
Office Version
  1. 365
Platform
  1. Windows
Hello - I have this VBA code which is actually working great!

As I am still learning VBA, most of this was the result of a recording the steps with some tweaks for auto-filling, and correcting some minor errors in my recording.

In any event, I am wondering if there is a more efficient, or quicker way of getting this code to run. Thanks as always for your help!

VBA Code:
Sub Prep_CallSmartSchedule()
'
' Prep_CallSmartSchedule Macro
'
' Keyboard Shortcut: Ctrl+d
'
' Replaces '=' and '"' with blanks from exported file
    Cells.Replace What:="=", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False, _
        FormulaVersion:=xlReplaceFormula2

    Cells.Replace What:="""", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
        , FormulaVersion:=xlReplaceFormula2
        
' Inserts temporary columns to right of Date
    Columns("F:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

' Selects Date column, and separates by '/' delimter
    Columns("E:E").Select
    Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
    TrailingMinusNumbers:=True

' Titles Column H as 'Date'
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Date"
    
' Concatenates the temporary Day, Month, Year values as 'MM/DD/YYYY'
    Range("H2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-2]&""/""&RC[-3]&""/""&RC[-1]"

' Auto Fill formula in Column H ('Date') to last row of data found in export file
    Range("G1").Activate
    Application.CutCopyMode = False
        With Range("H2")
      .AutoFill Destination:=Range("H2:H" & Range("G" & Rows.Count).End(xlUp).Row)
        End With
 
 ' Copy and Paste Values in Column H ('Date') to remove concatenation formula
    Columns("H:H").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
 ' Delete temporary Day, Month, Year columns
    Columns("E:G").Select
    Selection.Delete Shift:=xlToLeft

' Format Date Column
    Columns("E:E").Select
    Selection.NumberFormat = "m/d/yyyy"
    
    
End Sub
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,140
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
Try the code below (untested)

Code:
Sub Prep_CallSmartSchedule()
    '
    ' Prep_CallSmartSchedule Macro
    '
    ' Keyboard Shortcut: Ctrl+d
    '
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    ' Replaces '=' and '"' with blanks from exported file
    Activsheet.UsedRange.Replace What:="=", Replacement:="", LookAt:=xlPart, SearchOrder:= _
                                 xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False, _
                                 FormulaVersion:=xlReplaceFormula2

    Activsheet.UsedRange.Replace What:="""", Replacement:="", LookAt:=xlPart, SearchOrder _
                                 :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
                                                                                                    , FormulaVersion:=xlReplaceFormula2
        
    ' Inserts temporary columns to right of Date
    Columns("F:H").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    ' Selects Date column, and separates by '/' delimter
    Columns("E:E").TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
        TrailingMinusNumbers:=True

    ' Titles Column H as 'Date'
    Range("H1").Value = "Date"
    
    ' Concatenates the temporary Day, Month, Year values as 'MM/DD/YYYY'
    ' Auto Fill formula in Column H ('Date') to last row of data found in export file
    Range("H2:H" & Range("G" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=RC[-2]&""/""&RC[-3]&""/""&RC[-1]"

    ActiveSheet.Calculate

    ' Copy and Paste Values in Column H ('Date') to remove concatenation formula
    Columns("H:H").Value = Columns("H:H").Value
        
    ' Delete temporary Day, Month, Year columns
    Columns("E:G").Delete Shift:=xlToLeft

    ' Format Date Column
    Columns("E:E").NumberFormat = "m/d/yyyy"
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    
End Sub
 
Solution

GingaNinga

New Member
Joined
Sep 1, 2017
Messages
10
Office Version
  1. 365
Platform
  1. Windows
Try the code below (untested)

Code:
Sub Prep_CallSmartSchedule()
    '
    ' Prep_CallSmartSchedule Macro
    '
    ' Keyboard Shortcut: Ctrl+d
    '
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    ' Replaces '=' and '"' with blanks from exported file
    Activsheet.UsedRange.Replace What:="=", Replacement:="", LookAt:=xlPart, SearchOrder:= _
                                 xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False, _
                                 FormulaVersion:=xlReplaceFormula2

    Activsheet.UsedRange.Replace What:="""", Replacement:="", LookAt:=xlPart, SearchOrder _
                                 :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
                                                                                                    , FormulaVersion:=xlReplaceFormula2
      
    ' Inserts temporary columns to right of Date
    Columns("F:H").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    ' Selects Date column, and separates by '/' delimter
    Columns("E:E").TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
        TrailingMinusNumbers:=True

    ' Titles Column H as 'Date'
    Range("H1").Value = "Date"
  
    ' Concatenates the temporary Day, Month, Year values as 'MM/DD/YYYY'
    ' Auto Fill formula in Column H ('Date') to last row of data found in export file
    Range("H2:H" & Range("G" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=RC[-2]&""/""&RC[-3]&""/""&RC[-1]"

    ActiveSheet.Calculate

    ' Copy and Paste Values in Column H ('Date') to remove concatenation formula
    Columns("H:H").Value = Columns("H:H").Value
      
    ' Delete temporary Day, Month, Year columns
    Columns("E:G").Delete Shift:=xlToLeft

    ' Format Date Column
    Columns("E:E").NumberFormat = "m/d/yyyy"
  
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
  
End Sub
Thank you. Getting "Object Required" error on the below code. Not sure if there are other spots where it might hang.

VBA Code:
 Activsheet.UsedRange.Replace What:="=", Replacement:="", LookAt:=xlPart, SearchOrder:= _
                                 xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False, _
                                 FormulaVersion:=xlReplaceFormula2
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,140
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
There is an e missing in ActiveSheet... typo and again on the next block as it was copy/pasted.
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,140
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
You're welcome
 

Forum statistics

Threads
1,136,286
Messages
5,674,856
Members
419,530
Latest member
undisclosed

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top