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

• BruceWayne: Yeah, better for CodeReview - but may I suggest first avoid using .Select
• Mathieu Guindon: It's a little hard to tell what your code does without actually analyzing it - please edit your title to tell us what the code is doing (all questions on this site want to achieve simpler/better code) - thanks, and welcome to CR!

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.

• Diogo: 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.. :)

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.

• Diogo: @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.
• FreeMan: When you use Sheets("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 referencing Workbooks() or Worksheets() (or Sheets()).

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.

• user66882: Setting Require Variable Declaration within the VBE's Tools ► Options ► Editor property page will put the Option Explicit statement at the top of each newly created code sheet.

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