Slow Macro

[Philip1957]

Greetings,
I have a macro that splits a date/timestamp in a single column into a column with the date and a column with the time. It runs clean but is very slow with large worksheets.
Any suggestions on how to speed it up?

Option Explicit

Sub Split_Date_Time()

Application.ScreenUpdating = False

Application.DisplayAlerts = False

On Error Resume Next

Dim clmn As String

clmn = Application.InputBox("Enter the letter designating" & vbCrLf & _
    "the column where the date" & vbCrLf & "and time data is located.")

Columns(clmn).EntireColumn.Offset(0, 1).Select
    ActiveCell.EntireColumn.Insert Shift:=xlToRight

Columns(clmn).Select
    Selection.TextToColumns Destination:=Columns(clmn), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 3), Array(10, 1)), TrailingMinusNumbers:=True
    Columns(clmn).Select
    Selection.NumberFormat = "m/d/yy;@"
    ActiveCell.EntireColumn.Offset(0, 1).Select
    Selection.NumberFormat = "h:mm;@"

Selection(1).Activate
    ActiveCell.Value = "Add Time"
    ActiveCell.Font.Bold = True
    ActiveCell.HorizontalAlignment = xlCenter
    ActiveCell.Borders.ColorIndex = 1
    
Range(clmn & Rows.Count).End(xlUp).Select
ActiveCell.Offset(0, 1).Select
Do Until ActiveCell.Row = "1"
    ActiveCell.Borders.ColorIndex = 1

ActiveCell.Offset(-1, 0).Select

Loop

Application.ScreenUpdating = True

End Sub  'Split_Date_Time()

Any assistance is greatly appreciated.

~ Phil

 

[JGordon11]

try changing this part of your code:

Range(clmn & Rows.Count).End(xlUp).Select
ActiveCell.Offset(0, 1).Select
Do Until ActiveCell.Row = "1"
    ActiveCell.Borders.ColorIndex = 1

ActiveCell.Offset(-1, 0).Select

Loop

to this:

    Dim lastrow As Long
    lastrow = Range(clmn & Rows.Count).End(xlUp).Row
    Range(clmn & "1", clmn & lastrow).Borders.ColorIndex = 1

 

[Philip1957]

Thank you.
I'll give it a test later today.

 

[Philip1957]

Sorry it took so long for me to get back to you. Yes that runs much faster. Thanks!