The quickest fix you can make to improve speed is removing all of theSelect statements, and instead just referencing those selected ranges with variables. (Select slows down any VBA code significantly). You can also toggleApplication.ScreenUpdating to False before the code and True after to gain run-time speed.

• \$\begingroup\$The screenUpdating is = false inside the sub that call this one. The main sub calls bov_mobile, bov_xxx, bov_xxx2 and etc... I will try to avoid the select... Im doing first steps.. :)\$\endgroup\$

  Diogo

  – Diogo

  2016-07-13 14:44:20 +00:00

  CommentedJul 13, 2016 at 14:44

The main problem here is the use of .Select. There's no need to select the cells in order to manipulate them. It forces the GUI to update which is a very slow operation in Excel and it also causes Selection Change events and similar code to fire in the background. Simply perform the action on the cells directly. So, for example this:

Sheets("Mobile").SelectColumns("p").Clear

Should be changed to this

Sheets("Mobile").Columns("p").Clear

The same with your loop. Avoid this

ActiveCell.Offset(0, 14).Value

In favour of this

Cells(i,22).Value

Column 22 is 14 columns from column I. This increases efficiency in two ways: by not selecting the cell and also by avoiding the unnecessary calculation carried out by the Offset function.

• \$\begingroup\$@absinthe Ty! I got your point, but i call this sub from other sheet, so i have to move to it and start its routines.\$\endgroup\$

  Diogo

  – Diogo

  2016-07-13 14:42:58 +00:00

  CommentedJul 13, 2016 at 14:42
• 1
  \$\begingroup\$When you useSheets("Mobile") the VBA code will reference the sheet "Mobile"no matter what sheet is currently visible in the user interface without having to.Activate or.Select it. That's the beauty of explicitly referencingWorkbooks() orWorksheets() (orSheets()).\$\endgroup\$

  FreeMan

  – FreeMan

  2016-07-13 15:10:08 +00:00

  CommentedJul 13, 2016 at 15:10

First, things that jump out at me:

Private Sub bov_mobile()

Don't use_ in Sub/function names. In VBA,_ in a method name denotes an event-triggered Method E.G.Workbook_Open orButton_OnClick so avoid it in your own method names.

Option Explicit

That should be at the top of every VBA module you ever write. It requires you to declare variable names before you use them. E.G.Dim i As Long. This makes sure that youcan't do something like this:

Dim fim As Longfim = Cells(Rows.Count, 1).End(xlUp).RowFor i = 2 to fin ' <-- Typo

Because the compiler will ask whyfin hasn't been declared as a variable. Simple typos like that are a real pain, so don't give them a chance to appear in your code in the first place.

Use the Object Model

VBA has objects for everything.Workbooks,Worksheets,Ranges etc. Rather than something like this:

Sheets("Mobile").SelectSheets("Mobile").Range("A" & i).SelectSheets("Mobile").Range("P" & i).Copy Sheets("Mobile").Range("A" & i).PasteSpecial Paste:= xlPasteValues

You should instead:

Dim mobileSheet As WorksheetSet mobilesheet = Sheets("Mobile")mobileSheet.SelectmobileSheet.Range("A" & i).SelectmobileSheet.Range("P" & i).Copy mobileSheet.Range("A" & i).PasteSpecial Paste:= xlPasteValues

And then:

Dim mobileSheet As WorksheetSet mobilesheet = Sheets("Mobile")With mobileSheet    .Select    .Range("A" & i).Select    .Range("P" & i).Copy     .Range("A" & i).PasteSpecial Paste:= xlPasteValuesEnd With

And then:

Dim mobileSheet As WorksheetSet mobileSheet = Sheets("Mobile")With mobileSheet    Dim pasteCell As Range    Set pasteCell = .Range("A" & i)    Dim copyCell As Range    Set copyCell = .Range("P" & i)End WithWith CopyCell    .FormulaR1C1 = ....    .CopyEnd WithpasteCell.PasteSpecial Paste:=xlPasteValues

Notice how there are noSelects. There are noActives. There are noOffsets. Everything is descriptively named.

Your sub using proper objects and better naming:

Private Sub bov_mobile()    Dim mobileSheet As Worksheet    Set mobileSheet = ThisWorkbook.Sheets("Mobile")    Dim bovSheet As Worksheet    Set bovSheet = ThisWorkbook.Sheets("Mod_Bov")    mobileSheet.Columns("P").Clear    Dim finalRow As Long    With mobileSheet        finalRow = .Cells(.Rows.Count, 1).End(xlUp).Row    End With    Dim baseCell As Range    Dim copyCell As Range    Dim columnOffset As Long    Dim currentRow As Long    For currentRow = 2 To finalRow        With mobileSheet            Set baseCell = .Cells(currentRow, 1)            Set copyCell = .Cells(currentRow, 15)        End With        With copyCell            If .Text = "BOV" Or .Text = "BOV VMF" Then                .FormulaR1C1 = "=RC[-14]&"";""&RC[-13]&"";""&RC[-12]&"";""&RC[-11]&"";""&RC[-10]&"";""&RC[-9]&"";""&RC[-8]&"";""&RC[-7]&"";""&RC[-6]&"";""&RC[-5]&"";""&RC[-4]&"";""&RC[-3]&"";""&RC[-2]&"";"""                .Copy                baseCell.PasteSpecial xlPasteValues                Application.CutCopyMode = False            End If        End With    Next currentRow    Dim sortRange As Range    With mobileSheet        Set sortRange = .Range(.Cells(2, 16), .Cells(finalRow, 16))        sortRange.Sort Key1:=.Cells(2, 16), Order1:=xlAscending, Header:=xlGuess, _        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _        DataOption1:=xlSortNormal    End With    sortRange.Copy    Dim bovFinalRow As Long    With bovSheet        bovFinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row    End With    bovSheet.Cells(bovFinalRow + 1, 1).PasteSpecial xlPasteValuesEnd Sub

Much, much cleaner and easier to understand.

• 1
  \$\begingroup\$SettingRequire Variable Declaration within the VBE's Tools ► Options ► Editor property page will put theOption Explicit statement at the top of each newly created code sheet.\$\endgroup\$

  user66882

  – user66882

  2016-07-14 18:50:35 +00:00

  CommentedJul 14, 2016 at 18:50

I'd add my 0.02 cents

Pasting Values

it's always much faster to use

Range1.Value = Range2.Value

providedRange1 andRange2 have the same size

Avoiding formulas

they mean writing into cells which is a time consuming activity, and possibly raise sheet calculation

the following code:

"=RC[-14]&"";""&RC[-13]&"";""&RC[-12]&"";""&RC[-11]&"";""&RC[-10]&"";""&RC[-9]&"";""&RC[-8]&"";""&RC[-7]&"";""&RC[-6]&"";""&RC[-5]&"";""&RC[-4]&"";""&RC[-3]&"";""&RC[-2]&"";"""

can be substituted with:

Join(.Offset(, -13).Resize(, 14), ";")

AvoidWith inside a loop

you have such code

For currentRow = 2 To finalRow    With mobileSheet    ...Next currentRow

which means that a reference tomobileSheet is made at every loop

so just take it outside the loop:

With mobileSheet    For currentRow = 2 To finalRow        ....    Next currentRowEnd With

adjusting what necessary

UseWith

to lessen memory charge in referencing the same object multiple time

so that:

With mobileSheet    For currentRow = 2 To finalRow        ....    Next currentRowEnd WithDim sortRange As RangeWith mobileSheet    Set sortRange = .Range(.Cells(2, 16), .Cells(finalRow, 16))    sortRange.Sort Key1:=.Cells(2, 16), Order1:=xlAscending, header:=xlGuess, _    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _    DataOption1:=xlSortNormalEnd WithsortRange.Copy

becomes

With mobileSheet    For currentRow = 2 To finalRow        ....    Next currentRow    With .Range(.Cells(2, 16), .Cells(finalRow, 16))        .Sort Key1:=.Cells(2, 16), Order1:=xlAscending, header:=xlGuess, _        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _        DataOption1:=xlSortNormal        .Copy    End WithEnd With

Summary

all what above can lead to the following refactoring ofSub bov_mobile()

Option ExplicitPrivate Sub bov_mobile()    Dim currentRow As Long, finalRow As Long    Dim mobileSheet As Worksheet: Set mobileSheet = ThisWorkbook.Sheets("Mobile")    Dim bovSheet As Worksheet:  Set bovSheet = ThisWorkbook.Sheets("Mod_Bov")    With mobileSheet        .Columns("P").ClearContents '<-- ClearContents() is faster than Clear(), if you don't bother formatting        finalRow = .Cells(.Rows.Count, 1).End(xlUp).Row        For currentRow = 2 To finalRow            With .Cells(currentRow, 15)                If .Text = "BOV" Or .Text = "BOV VMF" Then .Parent.Cells(currentRow, 1).Value = Join(.Offset(, -13).Resize(, 14), ";")            End With        Next currentRow        With .Range(.Cells(2, 16), .Cells(finalRow, 16)) '<-- this is your "SortRange"            .Sort Key1:=.Cells(2, 16), Order1:=xlAscending, header:=xlGuess, _            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _            DataOption1:=xlSortNormal            bovSheet.Cells(bovSheet.Rows.Count, 1).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count).Value = .Value        End With    End WithEnd Sub

• excel
• vba