Trying to make more simple VBA

Question

I have few models like this below for diferent tools i manage. I am trying to clean/improve the code... Could you help me?

All the informations comes inside columns B to N, and the column P concatenate it with ";". There are 6 sheets i do the same thing.

Any ideas to have a better performance and cleaner code?

Private Sub bov_mobile()
Sheets("Mobile").Select
Columns("p").Clear
fim = Cells(Rows.count, 1).End(xlUp).Row

For i = 2 To fim
Range("A" & i).Select

    If ActiveCell.Offset(0, 14).Value = "BOV" Or ActiveCell.Offset(0, 14).Value = "BOV BMF" Then
        Range("P" & i).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]&"";"""
        Range("P" & i).Copy
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End If
Next i

    ' ###############  ORDER BY
    Range("p2", Cells(Rows.count, 16).End(xlUp)).Select
    Selection.Sort Key1:=Range("P2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

Range("P2", Cells(Rows.count, 16).End(xlUp)).Copy

Sheets("Mod_Bov").Select
Cells(Rows.count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues


End Sub

Answer 1

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

Answer 2

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").Select
Columns("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.

Answer 3

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 or Button_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 you can't do something like this:

Dim fim As Long
fim = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 to fin ' <-- Typo

Because the compiler will ask why fin 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").Select
Sheets("Mobile").Range("A" & i).Select
Sheets("Mobile").Range("P" & i).Copy 
Sheets("Mobile").Range("A" & i).PasteSpecial Paste:= xlPasteValues

You should instead:

Dim mobileSheet As Worksheet
Set mobilesheet = Sheets("Mobile")

mobileSheet.Select
mobileSheet.Range("A" & i).Select
mobileSheet.Range("P" & i).Copy 
mobileSheet.Range("A" & i).PasteSpecial Paste:= xlPasteValues

And then:

Dim mobileSheet As Worksheet
Set mobilesheet = Sheets("Mobile")

With mobileSheet

    .Select
    .Range("A" & i).Select
    .Range("P" & i).Copy 
    .Range("A" & i).PasteSpecial Paste:= xlPasteValues

End With

And then:

Dim mobileSheet As Worksheet
Set mobileSheet = Sheets("Mobile")

With mobileSheet

    Dim pasteCell As Range
    Set pasteCell = .Range("A" & i)

    Dim copyCell As Range
    Set copyCell = .Range("P" & i)

End With

With CopyCell

    .FormulaR1C1 = ....
    .Copy

End With

pasteCell.PasteSpecial Paste:=xlPasteValues

Notice how there are no Selects. There are no Actives. There are no Offsets. 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 xlPasteValues

End Sub

Much, much cleaner and easier to understand.

Answer 4

I'd add my 0.02 cents

---

Pasting Values

it's always much faster to use

Range1.Value = Range2.Value

provided Range1 and Range2 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), ";")

---

Avoid With inside a loop

you have such code

For currentRow = 2 To finalRow

    With mobileSheet

    ...
Next currentRow

which means that a reference to mobileSheet is made at every loop

so just take it outside the loop:

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

adjusting what necessary

---

Use With

to lessen memory charge in referencing the same object multiple time

so that:

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

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

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 With
End With

---

Summary

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

Option Explicit

Private 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 With
End Sub