How do I make my copy and paste loop more smooth? VBA EXCEL

Question

I want my macro to select specific selection of data based on the datediff value in one cell, then copy and paste it into another sheet. It does this, but it keeps flickering back and forth, giving a glitchy/choppy appearance. Any tips/ideas for how to fix it?

Sub Invoice()

Dim s As Integer
s = 2

Dim t As Integer
t = 21

Dim Newbook As Workbook
Set Newbook = Workbooks.Add
Workbooks("Workbook2.xlsm").Sheets("Invoice Template (2)").Copy     Before:=Newbook.Sheets(1)
    ActiveSheet.Name = "Current Invoice"

Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

Do Until IsEmpty(Cells(s, 1))
mini = Cells(s, 21).Value 'The datediff value I want to find'
If mini = "2" Then

Cells(s, 10).Copy
Newbook.Activate
Newbook.Sheets("Current Invoice").Select
Nextrow = Cells(t, 2).Row
Cells(Nextrow, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

Cells(s, 8).Copy
Newbook.Activate
Newbook.Sheets("Current Invoice").Select
Nextrow = Cells(t, 3).Row
Cells(Nextrow, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate


Cells(s, 11).Copy
Newbook.Activate
Newbook.Sheets("Current Invoice").Select
Nextrow = Cells(t, 7).Row
Cells(Nextrow, 7).Select
Selection.PasteSpecial Paste:=xlPasteValues
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

'Calulating the Premium'
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate
If Cells(s, 9) = 1001 Then  'Formula for Life, AD & D, ASI, CI'
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Prem = (Cells(t, 2) * Cells(t, 7)) / 1000
    Cells(t, 9).Value = Prem
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

ElseIf Cells(s, 9) = 1103 Then  'Formula for LTD'
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Prem = (Cells(t, 2) * Cells(t, 7)) / 100
    Cells(t, 9).Value = Prem
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

ElseIf Cells(s, 9) = 1104 Then  'Formula for STD'
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Prem = (Cells(t, 2) * Cells(t, 7)) / 10
    Cells(t, 9).Value = Prem
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

ElseIf Cells(s, 9) = 2112 Then  'General Formula'
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Prem = Cells(t, 2) * Cells(t, 7)
    Cells(t, 9).Value = Prem
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate
End If


'Calculating Commission'

Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate
If Cells(s, 15) = 5501 Then
'Add Commission schedule for ACE AND AIG'
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

ElseIf Cells(s, 15) = 5514 Then
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Cells(18, 4) = 0.06 'Commission Rate'
    Cells(38, 8) = 0.9  'Front-Load Payment'
    Cells(39, 8) = 0.1  'Hold Back Amount'
 Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate
End If


'Business and Insurer Information'

    'Insurer Name'
    Cells(s, 14).Copy
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Cells(8, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

    'Insurer Address'
    Cells(s, 16).Copy
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Cells(9, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate


    'Insert Solution for City, Province, Postal Code'

    'Client Name'
    Cells(s, 3).Copy
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Cells(13, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

    'Client Address'
    Cells(s, 4).Copy
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Cells(14, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

    'Insert Solution for City, Province, Postal Code'
    Cells(s, 1).Copy
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Cells(10, 9).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

    'Renewal Date'
    Cells(s, 22).Copy
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Cells(11, 9).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

    'Anniversary Date'
    Cells(s, 20).Copy
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Cells(12, 9).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

    Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate
t = t + 1



End If


s = s + 1
Loop

Newbook.Activate

Dim Client As String
Client = Cells(13, 2).Value

    Dim Presently As String
    Presently = " - " & MonthName(Month(Date)) & " " & Year(Date)
    'ActiveWorkbook.SaveAs Filename:=Client & "Invoice" & Presently'

End Sub

[This](http://msdn.microsoft.com/en-us/library/office/ff193498(v=office.15).aspx) might be helpful for you...Also, [see this](http://stackoverflow.com/questions/10714251/excel-macro-avoiding-using-select/10718179#10718179) for tips on how to make your code more robust. — ARich, Mar 07 '14 at 15:03

David Zemens · Accepted Answer · 2014-03-07T17:53:27.257

You could simplify all of the blocks of code like this:

Cells(s, 10).Copy
Newbook.Activate
Newbook.Sheets("Current Invoice").Select
Nextrow = Cells(t, 2).Row
Cells(Nextrow, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

To something like this instead (all three blocks, simplified to this):

Newbook.Sheets("Current Invoice").Cells(t, 2).Value = Cells(s, 10).Value

Newbook.Sheets("Current Invoice").Cells(t, 3).Value = Cells(s, 8).Value

Newbook.Sheets("Current Invoice").Cells(t, 7).Value = Cells(s, 11).Value

You could also simplify all of this:

If Cells(s, 9) = 1001 Then  'Formula for Life, AD & D, ASI, CI'
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Prem = (Cells(t, 2) * Cells(t, 7)) / 1000
    Cells(t, 9).Value = Prem
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

ElseIf Cells(s, 9) = 1103 Then  'Formula for LTD'
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Prem = (Cells(t, 2) * Cells(t, 7)) / 100
    Cells(t, 9).Value = Prem
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

ElseIf Cells(s, 9) = 1104 Then  'Formula for STD'
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Prem = (Cells(t, 2) * Cells(t, 7)) / 10
    Cells(t, 9).Value = Prem
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

ElseIf Cells(s, 9) = 2112 Then  'General Formula'
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Prem = Cells(t, 2) * Cells(t, 7)
    Cells(t, 9).Value = Prem
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate
End If

To this:

Dim wsInvoice as Worksheet
Set wsInvoice = Newbook.Sheets("Current Invoice")  'You could move these lines the the 
                                                   ' beginning of your code and replace
                                                   ' all references to NewBook.Sheets("CurrentInvoice") with wsInvoice 


With wsInvoice
Select Case Cells(s, 9)
    Case 1001  'Formula for Life, AD & D, ASI, CI'
        Prem = (.Cells(t, 2) * .Cells(t, 7)) / 1000
    Case 1103  'Formula for LTD'
        Prem = (.Cells(t, 2) * .Cells(t, 7)) / 100
    Case 1104  'Formula for STD'
        Prem = (.Cells(t, 2) * .Cells(t, 7))  / 10
    Case 2112  'General Formula'
        Prem = (.Cells(t, 2) * .Cells(t, 7)) 
End Select

.Cells(t, 9).Value = Prem
End With

You're welcome! I made a revision and simplified another big block of your code, too. Cheers. — David Zemens, Mar 07 '14 at 17:21
OMG! Thank you! It's so much faster and in one motion! You are amazing! :') — s.patter, Mar 07 '14 at 18:03

score 3 · Answer 2 · answered Mar 07 '14 at 15:07

Use application.screenupdating = false which stops the screen from being refreshed. so the user will not see what is going on untill after A) the code encounters a application.screenupdating = true or all the code has finished. The should also speed up code time too.

score 0 · Answer 3 · answered Mar 07 '14 at 15:08

Your code will fail if there are any other applications monitoring the clipboard. You cannot copy and then expect to immediately be able to paste the data. As soon as you perform the copy, Windows notifies other applications of the update, and they can (and will) seize the clipboard to grab the data. Examples are Remote Desktop, any clipboard monitor/extender, MS Office Clipboard, various browser extensions, even Google Earth.

At a minimum, you'll need a sleep/retry loop around the paste.

How do I make my copy and paste loop more smooth? VBA EXCEL

3 Answers3