VBA macro runs too long

KPKP

New Member
Joined
Feb 8, 2022
Messages
10
Office Version
  1. 2007
Platform
  1. Windows
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!

VBA Code:
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
 
Last edited by a moderator:

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Try this:

VBA Code:
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
 
Upvote 0
Solution
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 :)
 
Upvote 0
I'm glad to help you. Thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,218,808
Messages
6,144,598
Members
450,555
Latest member
sheldor

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
Back
Top