Excel Copy values faster

Question

Hello everyone I am back with yet another beginner question.

I recently wrote a code in VBA for a button, which copies values from one sheet to another. The first sheet I use to make some custom entry and the destination sheet is like a database with all the entries. This at first worked out quite well but the more entries in the database the slower the script gets.

I was wondering if there is a way to speed up the process or at least provide me with the possibility to change the sheet once I pressed the button and to some other tasks.

My code:

Variablews is the sheet that contains the data and the button.
Variable ws1 is the database location.

Private Sub CommandButton1_Click()

Dim Ticker As String, Nameofcompany As String, Industry As String, Sector As String, Price As String, MC As String, Revenue As String, Valuation As String, Confidence As String, Criteria As String, Watchlist As String, Track As String, Today As String, ExTicker As Range
Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet
Set ws = Sheet4
Set ws1 = Sheet3
Set ws2 = Sheet2

ws.Select
Ticker = Range("Ticker")
Set ExTicker = ws1.Range("C5:C500").Find(what:=Ticker, LookIn:=xlValues, lookat:=xlWhole)
If ExTicker Is Nothing Then
    Nameofcompany = Range("Name")
    Industry = Range("Industry")
    Sector = Range("Sector")
    Price = Range("Price")
    MC = Range("MC")
    Revenue = Range("Revenue")
    Valuation = Range("Valuation")
    Confidence = Range("Confidence")
    Criteria = Range("Criteria")
    Watchlist = Range("Watchlist")
    Track = Range("Track")
    Today = Range("O5")
    ws1.Select
    ws1.Range("C4").Select
    If ws1.Range("C4").Offset(1, 0) <> "" Then
    ws1.Range("C4").End(xlDown).Select
    End If
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = Ticker
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Nameofcompany
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Industry
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Sector
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Price
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = MC
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Revenue
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Valuation
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Confidence
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Criteria
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Watchlist
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Track
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Today
    Else
    MsgBox "This company is already in the list"
End If
End Sub

Read this https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba You could put your range names into an array and loop through that. You don't need all those variables though I doubt they will slow anything down. — SJR, Mar 17 '21 at 09:12

score 3 · Answer 1 · answered Mar 17 '21 at 09:36

Following on from comments, an approach which avoids the Selects, finds the last row working up from the bottom (more robust) and uses a loop to cut down on the size of your code.

Private Sub CommandButton1_Click()

Dim Ticker As String, ExTicker As Range
Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet, i As Long, v As Variant

Set ws = Sheet4
Set ws1 = Sheet3
Set ws2 = Sheet2

Application.ScreenUpdating = False

ws.Select
Ticker = Range("Ticker")
Set ExTicker = ws1.Range("C5:C500").Find(what:=Ticker, LookIn:=xlValues, lookat:=xlWhole)
If ExTicker Is Nothing Then
    v = Array("Name", "Industry", "Sector") 'etc
    For i = LBound(v) To UBound(v)
        ws1.Range("C" & Rows.Count).End(xlUp)(2).Value = Range(v(i)).Value
    Next i
Else
    MsgBox "This company is already in the list"
End If

Application.ScreenUpdating = True

End Sub

FaneDuru · Answer 2 · 2021-03-17T12:11:46.380

Try the next code, please. It should be very fast, dropping the array content at once. Not so many variables to be used, too:

Private Sub CommandButton1_Click()
 Dim ExTicker As Range, lastRow As Long, arrNms
 Dim ws As Worksheet, ws1 As Worksheet

 Set ws = ActiveSheet 'having the button there, it should be the active sheet...
 Set ws1 = Sheet3     'your data base sheet

 Set ExTicker = ws1.Range("C5:C500").Find(what:=Range("Ticker").value, LookIn:=xlValues, lookat:=xlWhole)
 If ExTicker Is Nothing Then
    arrNms = Array(Range("Ticker").value, Range("Name").value, Range("Industry").value, Range("Sector").value, _
             Range("Price").value, Range("MC").value, Range("Revenue").value, Range("Valuation").value, _
             Range("Confidence").value, Range("Criteria").value, Range("Watchlist").value, Range("Track").value, Range("O5").value)
    lastRow = ws1.Range("C" & ws1.rows.count).End(xlUp).row
    ws1.Range("C" & lastRow + 1).Resize(1, UBound(arrNms) + 1).value = arrNms
 Else
    MsgBox "This company is already in the list"
 End If
End Sub

You must only check if I did not miss the necessary named ranges order. I think not, I tried copying from your code in the order they appeared, but not bad to check it.

Alexey · Answer 3 · 2021-03-17T09:36:31.473

Private Sub CommandButton1_Click()
  Application.ScreenUpdating = False
  Dim Ticker As String, Nameofcompany As String, Industry As String, Sector As String, Price As String, MC As String, Revenue As String, Valuation As String, Confidence As String, Criteria As String, Watchlist As String, Track As String, Today As String, ExTicker As Range
  Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet
  Set ws = Sheet4
  Set ws1 = Sheet3
  Set ws2 = Sheet2

  Ticker =ws.Range("Ticker").value
  Set ExTicker = ws1.Range("C5:C500").Find(what:=Ticker, LookIn:=xlValues, lookat:=xlWhole)
  If ExTicker Is Nothing Then
    Nameofcompany = Range("Name").value
    Industry = Range("Industry").value
    Sector = Range("Sector").value
    Price = Range("Price").value
    MC = Range("MC").value
    Revenue = Range("Revenue").value
    Valuation = Range("Valuation").value
    Confidence = Range("Confidence").value
    Criteria = Range("Criteria").value
    Watchlist = Range("Watchlist").value
    Track = Range("Track").value
    Today = Range("O5").value
     ' what is this code below with if for? 
     If ws1.Range("C4").Offset(1, 0) <> "" Then
        ws1.Range("C4").End(xlDown).Select
     End If
     With ActiveCell
        .Offset(1, 0).Value = Ticker
        .Offset(1, 1).Value = Nameofcompany
        .Offset(1, 2).Value = Industry
        .Offset(1, 3).Value = Sector
        .Offset(1, 4).Value = Price
        .Offset(1, 5).Value = MC
     ' etc till the last variable
      End with
     Else
         MsgBox "This company is already in the list"
     End If
 Application.ScreenUpdating = True 
 End Sub

the code with if, is for checking that it will always input the data on the next free line. didn't know how else to solve it. Thanks a lot will try it out — Patrick, Mar 17 '21 at 09:32

score 1 · Answer 4 · answered Mar 17 '21 at 09:41

There is no need to create string variables for this case.

Also, looks like you could optimize:

Turn off screen updating
Turn off automatic calculations
Disable events
Use With statement

I haven't run the following code which is a modified version of yours, hopefully a better one. Try it, if it has some issues then you could use it to take ideas to improve yours.

Private Sub CommandButton1_Click()

'turn off unnecessary applications for speed
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Dim ws As Worksheet: Set ws = Sheet4
Dim ws1 As Worksheet: Set ws1 = Sheet3
Dim ws2 As Worksheet: Set ws2 = Sheet2

Dim ExTicker As Range: Set ExTicker = _
ws1.Range("C5:C500").Find(what:=Ticker, LookIn:=xlValues, lookat:=xlWhole)

ws.Select

If ExTicker Is Nothing Then
   
    With ws1
        .Select
        .Range("C4").Select
        If .Range("C4").Offset(1, 0) <> "" Then
            .Range("C4").End(xlDown).Select
        End If
    End With
    
    With ActiveCell
        .Offset(1, 0).Select
        .Value = Range("Ticker")
        .Offset(0, 1).Select
        .Value = Range("Name")
        .Offset(0, 1).Select
        .Value = Range("Industry")
        .Offset(0, 1).Select
        .Value = Range("Sector")
        .Offset(0, 1).Select
        .Value = Range("Price")
        .Offset(0, 1).Select
        .Value = Range("MC")
        .Offset(0, 1).Select
        .Value = Range("Revenue")
        .Offset(0, 1).Select
        .Value = Range("Valuation")
        .Offset(0, 1).Select
        .Value = Range("Confidence")
        .Offset(0, 1).Select
        .Value = Range("Criteria")
        .Offset(0, 1).Select
        .Value = Range("Watchlist")
        .Offset(0, 1).Select
        .Value = Range("Track")
        .Offset(0, 1).Select
        .Value = Range("O5") 'today
    End With
    
    Else
    MsgBox "This company is already in the list"
    
End If

'turn on applications
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub

For more information on improving speed: https://analysistabs.com/vba/optimize-code-run-macros-faster/

Note: If you have a problem running the macro and it debugs because of an error, Excel could start working weird, due to disabling applications without turning them on again. In that case you can run the following macro just to turn applications back on:

Sub turn_applications_on()

   'turn on applications
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Sub

Or you can just restart Excel.

@Patrick in case you don't know you can test the macro line by line using F8 on Windows. — Gass, Mar 17 '21 at 09:46

Excel Copy values faster

4 Answers4