New to VBA programming and need help to Optimize VBA code

Question

Good Evening...

I am very new to VBA... have only been playing with it for about a week, and need to help to optimize a macro.

Currently it takes about 23 seconds for it to run... and was hoping to get it down a bit.

First step is a push button to "select file location" then one table from the DB is downloaded into a worksheet called "hidden" and finally columns B:L are copied from "hidden" to "UPS Tariff"

Any suggestions are greatly appreciated

Sub Selectfile()

Dim filename As String

filename = Application.GetOpenFilename(MultiSelect:=False)

Range("c2") = filename

Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer

Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sQRY As String
Dim rng As Range
Dim cell As Range
Dim sourcefile As String


sourcefile = Sheet1.Range("C2")
Sheets("Hidden").Visible = True
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set rng = Sheet9.Range("B1:B762")

cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & sourcefile & ";"
sQRY = "SELECT * FROM Tariff"
rs.CursorLocation = adUseClient
rs.Open sQRY, cnn, adOpenStatic, adLockReadOnly
Application.ScreenUpdating = False
Sheet9.Range("A1").CopyFromRecordset rs
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing

For Each cell In rng
If cell <> "Letter" And cell <> "NDA" And cell <> "NDAS" And cell <> "2DA" And cell <> "3DS" And cell <> "GND" Then cell.Value = cell.Value * 1
Next cell

    Sheets("Hidden").Select
    Range("B1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("UPS Tariff").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Hidden").Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Clear
    Sheets("Info").Select

Sheets("Hidden").Visible = xlVeryHidden
SecondsElapsed = Round(Timer - StartTime, 2)

'Notify user in seconds
  MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

End Sub

Answer 1

You are doing an OLEDB Connection which may be slowing down the whole process. Nonetheless, there are few things that you could improve in your code:

• 1) Don't do so many range.selects.

• 2) Try using the with statement in your code. This speeds up your process quite a bit.

  For example the following code:

  Sheets("Hidden").Select
  Range("B1").Select
  Range(Selection, Selection.End(xlToRight)).Select
  Range(Selection, Selection.End(xlDown)).Select
  Selection.Copy
  Sheets("UPS Tariff").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
  Range("A1").Select
  Sheets("Hidden").Select
  Range("A1").Select
  Range(Selection, Selection.End(xlToRight)).Select
  Range(Selection, Selection.End(xlDown)).Select
  Application.CutCopyMode = False
  Selection.Clear
  Sheets("Info").Select
  

Could be transformed to something like this:

    With Sheets("Hidden")
       'copy your selection
       .Range(.cells(1,2), .cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Copy' e.g. if you want to select the whole area in the worksheet

       'paste selection to the destination cell
       Sheets("UPS Tariff").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
           :=False, Transpose:=False

       Application.CutCopyMode = False'gets rid of the highlighted copy area under your Sheets workbook

       'clears the initial selection
       .Range(.cells(1,2), .cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Clear
    End With

    Sheets("Info").Select

Not only that the code becomes more efficient for the VBA processor, but it is also more readable for you once you need to review / change it.

Another thing that really speeds up the process are the following lines:

Application.ScreenUpdating = False

The above stops the screen flickering every time new line of code is executed.

Application.Calculation = xlCalculationManual

The above stops all the formulas to be re-calculated every time you do a change in the worksheet.

Application.EnableEvents = false

Another one, which disables all the worksheet events such as worksheet_Activate, Worksheet_Change, ...

However you need to make sure, that once all your code finished running, you turn those features on again (otherwise your cells will stop recalculating and screen will stop refreshing itself).

Normally what I do is that I create a new module where I put all the support code. There I create the following two functions:

Public Sub EnableExcel()
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

Public Sub DisableExcel()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
End Sub

As you can see, these functions are marked as public and therefore can be accessed from everywhere within your workbook.

Then my procedure would look like this:

Private Sub DoSomeStuff()
    On Error GoTo EarlyExit
    Call DisableExcel

    'this will fail as it is division by zero
    MsgBox 1 / 0

EarlyExit:
    Call EnableExcel
    If Err.Description <> vbNullString Then MsgBox Err.Description
End Sub

What you can see, is the important error catcher. I would really recomment reading more about these online. Basically what the code does here is, that if something fails during the code execution (I made an example that you are trying to divide by zero), then the code would not completely fail, but will display the error message to the user with the error description. Also, it makes sure that if the code fails, your EnableExcel macro is executed no matter what.

These are really just a few tips I can give. The more you work with VBA and more you read (e.g. on StackOverflow), the better you become. Good luck!