VBA macro runs too long

[KPKP]

I have a macro that I run on opened CSV files. The files are typically only 20 or 30 rows of data. The macro reorders the data from bottom to top using an Autofill command and adjusts a few column settings. Nothing earth shattering. The "working" icon will often spin for more than 30 seconds before the results are displayed. Can anyone see what I've done wrong or suggest more efficient code? Appreciate your time!

Sub FormatTextFile()
    Application.CutCopyMode = False     'this is equivalent to hitting ESC. Clears any previous clipboard entry before starting new command
    Application.ScreenUpdating = False
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Names.Add Name:="ALLROWS", RefersToR1C1:=Selection
    Selection.ClearContents
    ActiveCell.Select
    ActiveCell.FormulaR1C1 = "1"
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "2"
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "3"
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "4"
    ActiveCell.Offset(-3, 0).Range("A1:A4").Select
    Selection.AutoFill Destination:=ActiveCell.Range("ALLROWS"), Type:= _
        xlFillDefault
    ActiveCell.Range("ALLROWS").Select
    Selection.Resize(, 7).Select
    Names.Add Name:="DATA", RefersToR1C1:=Selection
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=ActiveCell. _
        Range("ALLROWS"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange ActiveCell.Range("DATA")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 12
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 75
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.EntireColumn.Insert
    ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 6
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 12
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.EntireColumn.Insert
    Selection.EntireColumn.Insert
    ActiveCell.Offset(0, 2).Range("A1").Select
    ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 12
    ActiveCell.Offset(0, -3).Range("A1").Select
    Application.CutCopyMode = False
   
'    This section of code moves Debit values from Column E to Column F in the CSV file.
    Do
        If ActiveCell.Value > 0 Then
            Selection.Cut
            ActiveCell.Offset(0, 1).Range("A1").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            ActiveCell.Offset(1, -1).Range("A1").Select
            Application.CutCopyMode = False
        Else
            ActiveCell.Offset(1, 0).Select
            Application.CutCopyMode = False
        End If
    Loop Until ActiveCell.Value = ""
    Range("B1").Select
    Application.CutCopyMode = False
End Sub

 

[DanteAmor]

Try this:

Sub FormatTextFile()
  Dim lr As Long, i As Long
  Dim a As Variant
  
  Application.ScreenUpdating = False
  lr = Range("A" & Rows.Count).End(3).Row
  Range("A1").Value = 1
  Range("A1:A" & lr).DataSeries xlColumns, xlLinear, xlDay, 1
  
  Range("A1:G" & lr).Sort key1:=Range("A1"), order1:=xlDescending, Header:=xlNo
  Range("B:B").ColumnWidth = 12
  Range("C:C").ColumnWidth = 75
  Range("D:D").EntireColumn.Insert
  Range("D:D").ColumnWidth = 6
  Range("E:E").ColumnWidth = 12
  Range("F:G").EntireColumn.Insert
  Range("H:H").ColumnWidth = 12
  
  '    This section of code moves Debit values from Column E to Column F in the CSV file.
  With Range("E1:F" & lr)
    a = .Value
    For i = 1 To UBound(a, 1)
      If a(i, 1) > 0 Then
        a(i, 2) = a(i, 1)
        a(i, 1) = ""
      End If
    Next
    .Value = a
  End With
  Range("B1").Select
End Sub

 

[KPKP]

Sub FormatTextFile() Dim lr As Long, i As Long Dim a As Variant Application.ScreenUpdating = False lr = Range("A" & Rows.Count).End(3).Row Range("A1").Value = 1 Range("A1:A" & lr).DataSeries xlColumns, xlLinear, xlDay, 1 Range("A1:G" & lr).Sort key1:=Range("A1"), order1:=xlDescending, Header:=xlNo Range("B:B").ColumnWidth = 12 Range("C:C").ColumnWidth = 75 Range("D:D").EntireColumn.Insert Range("D:D").ColumnWidth = 6 Range("E:E").ColumnWidth = 12 Range("F:G").EntireColumn.Insert Range("H:H").ColumnWidth = 12 ' This section of code moves Debit values from Column E to Column F in the CSV file. With Range("E1:F" & lr) a = .Value For i = 1 To UBound(a, 1) If a(i, 1) > 0 Then a(i, 2) = a(i, 1) a(i, 1) = "" End If Next .Value = a End With Range("B1").Select End Sub

So awesome! Your version ran instantly and produced correct results. Thank you so much for taking the time to do this! You're my hero

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.