Altering spreadsheet data

Question

I have the below code that helps me do some formatting. But I want to increase the efficiency of the code by making it faster. Below are the formatting steps of the macro.

Convert "Q" and "S" column to number format.
Replicate the "I" column to new column by inserting a column next to it.
Cut the column "AD" and paste to column "O".
Remove columns ("A:A,AD:AG").
Replace "#" with null and "OUT" with P input value in "AC" column.
Round the "Q" and "S" column numbers to 2 decimal.
Change the sign of values in column Q by multiplying -1(i.e. *-1).
Filter on "Q" column with "0" and filter on "S" column with "0". Then remove those rows with "Q" and "S" is Zero.
Filter 0 on Q column, Clear only visible cells of "Q" and "R" Columns.
Filter 0 on "S" column, Clear only visible cells of "S" and "T" Columns.
Copy the headers (ThisWorkbook.Sheets("Tool").Range("A20:AC20").Copy) and paste to the A1 of file formatted.
Remove all columns and rows which doesn’t have data apart from used range.

Currently macro working fine but taking some time. As I'm new to VBA, I'm not sure how to optimize the code. Hence I'm here looking for help from experts.

Below is the code:

Sub A_to_B() 
Dim LastRow As Long Dim Lastcol As Long Dim P As String 
   'Display a Dialog Box that allows to select a single file. 'The path
   for the file picked will be stored in fullpath variable   With
   Application.FileDialog(msoFileDialogFilePicker)
           'Makes sure the user can select only one file
           .AllowMultiSelect = True
           'Filter to just the following types of files to narrow down selection options
           '.Filters.Add "All Files", "*.xlsx; *.xlsm; *.xls; *.xlsb; *.csv"
           'Show the dialog box
           .Show
          'Store in fullpath variable
           fullpath = .SelectedItems.Item(1)
       End With
      'It's a good idea to still check if the file type selected is accurate.
       'Quit the procedure if the user didn't select the type of file we need.
       If InStr(fullpath, ".xls") = 0 Then
       If InStr(fullpath, ".csv") = 0 Then
           Exit Sub
       End If
       End If
        'Open the file selected by the user
       Workbooks.Open fullpath
       P = InputBox("Please Enter the Version")
       Application.ScreenUpdating = False
     With ActiveWorkbook
       Columns(17).NumberFormat = "0"
       Columns(19).NumberFormat = "0"
       LastRow = Cells(Rows.Count, 2).End(xlUp).Row
       Lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
       Columns("I").Copy
       Columns("I").Insert Shift:=xlToRight
       'Range("AE2").Value = P
       'Range("AE2", "AE" & Cells(Rows.Count, "B").End(xlUp).Row).FillDown
       Columns("AE").Copy
       Columns("P").PasteSpecial xlPasteValues
       ActiveSheet.Range("A:A,AE:AG").EntireColumn.Delete
       Columns("AC").Replace What:="#", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,
   ReplaceFormat:=False
       Columns("AC").Replace What:="OUT", Replacement:=P, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False,
   SearchFormat:=False, ReplaceFormat:=False
       Range("AD2").Formula = "=Round(Q2,2)"
       Range("AD2", "AD" & Cells(Rows.Count, "B").End(xlUp).Row).FillDown
       Range("AD2", "AD" & Cells(Rows.Count, "B").End(xlUp).Row).Copy
       Range("Q2").PasteSpecial xlPasteValues
       Range("AD2").Formula = "=Round(S2,2)"
       Range("AD2", "AD" & Cells(Rows.Count, "B").End(xlUp).Row).FillDown
       Range("AD2", "AD" & Cells(Rows.Count, "B").End(xlUp).Row).Copy
       Range("S2").PasteSpecial xlPasteValues
       Range("AD2").Formula = "=(Q2*-1)"
       Range("AD2", "AD" & Cells(Rows.Count, "B").End(xlUp).Row).FillDown
       Range("AD2", "AD" & Cells(Rows.Count, "B").End(xlUp).Row).Copy
       Range("Q2").PasteSpecial xlPasteValues
       Columns("AD:AD").EntireColumn.Delete With ActiveSheet.Range("A:AC")
       .AutoFilter Field:=17, Criteria1:="0"
       .AutoFilter Field:=19, Criteria1:="0"
       .Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
       .AutoFilter
       .AutoFilter Field:=17, Criteria1:="0"
       .Range("Q2:R" & LastRow).SpecialCells(xlCellTypeVisible).Clear
       .AutoFilter
       .AutoFilter Field:=19, Criteria1:="0"
       .Range("S2:T" & LastRow).SpecialCells(xlCellTypeVisible).Clear
       .AutoFilter
       '.Range("C2").AutoFill .Range("C2:C" & .Cells(.Rows.Count, "B").End(xlUp).Row)
       End With End With ThisWorkbook.Sheets("Tool").Range("A20:AC20").Copy
   ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteValues
   Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
   Rows("1").SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
   'ActiveWorkbook.Save 
'ActiveWorkbook.Close 
MsgBox "Done With Farmatting" 
End Sub

Ahoy! I [changed the title]() so that it describes what the code does per site goals: "State what your code does in your title, not your main concerns about it.". Feel free to edit and give it a different title if there is something more appropriate. — Sᴀᴍ Onᴇᴌᴀ
– Sᴀᴍ Onᴇᴌᴀ ♦, Commented Mar 23, 2020 at 12:34

Kate · Accepted Answer · 2020-03-23 18:16:53Z

Unfortunately it's difficult to provide actionable advice here, because the purpose you are trying to achieve is not explained. What would help is sample data, and a clear description of what your script does.

I cannot guess what you are doing, I have no idea if all that even makes sense, surely there must be a better way but we need more insight. Besides, your code is not properly formatted and seems to be missing a few line breaks.

Anyway, and since I am not a mind reader I will just make some suggestions:

use meaningful names for your variables and procedures: Sub A_to_B() is meaningless, the procedure should have a more descriptive name
you should add more comments, describe every action and why you do it unless it is very obvious
add some spacing between lines and logical blocks to make reading easier
proper tabulation too
you have multiple references to ActiveWorkbook or ActiveSheet, but the user could switch to another sheet while the macro is running, thus your code could be running out of scope and likely crash. There are some caveats with these methods too. ActiveWorkbook is not the workbook where your code resides. It is the last one that had the focus. Better make an explicit reference to a named sheet.
use named ranges rather than static ranges like AD2:BC500: they all look the same and you are never quite sure what they represent, so it's easy to confuse them. You can create named ranges on the fly too, and then use them in your code. This is more flexible than repeating stuff like Range("AD2", "AD" & Cells(Rows.Count, "B"). The first benefit is that the named range is defined only once, and then reused as many times as you want. The other benefit is that the named range is more descriptive than a range made up of a number and letters.
rather than hardcoding numbers like: .AutoFilter Field:=17, use constant variables. Surely 17 or 19 have a special meaning.
you have Application.ScreenUpdating = False but where is Application.ScreenUpdating = True ?

The code doesn't seem to be difficult, and could be so much more readable than it currently is.

Regarding speed of execution, you need to figure out yourself, because I am not able to reproduce your environment. If you have 5 million rows, then this is likely going to take time and it's normal. What I would do is add a timestamp trace between each operation to find out which parts are slower. It could be the Replace statements but I have no way to tell.

Here is one trick that could help but you have to try it: in the beginning of your code add this to suspend automatic recalculation:

Application.Calculation = xlManual

Then turn it back on when done:

Application.Calculation = xlAutomatic

Using Application.ScreenUpdating is a good thing but there is more than can be done.

Stack Exchange Network

Altering spreadsheet data

1 Answer 1

You must log in to answer this question.

Hot Network Questions

Altering spreadsheet data

1 Answer 1

You must log in to answer this question.

Related

Hot Network Questions