CODEWITHSUNDEEP
excelvbamacros
J Junior
J Junior

Reputation: 25

making vba macro more efficient

This macro looks at a row, copies the content and pastes it into desired cells in certain sheets.

I´d like to make this macro code quicker because it takes too long. The code loops over about 7000 rows.

Any help would be appreciated,

Here´s my code:

Sub Input_Template()

Application.ScreenUpdating = False

Sheets("Cost Gained").Select
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.EntireRow.Hidden = False
ActiveCell.Offset(1, 0).Select
Loop
Do

'Qc Note
ActiveCell.Offset(0, 0).Select
Selection.Copy
Sheets("Debit Note").Select
Range("G8,C6").Select
ActiveSheet.PasteSpecial
Range("C6").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(R[2]C[4], ""DN"")"

'Supplier Name
Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("G11").Select
ActiveSheet.PasteSpecial

'RTV Number
Sheets("Cost Gained").Select
ActiveCell.Offset(0, 2).Select
Selection.Copy
Sheets("Debit Note").Select
Range("G16,C22").Select
ActiveSheet.PasteSpecial

'Cost
Sheets("Cost Gained").Select
ActiveCell.Offset(0, 2).Select
Selection.Copy
Sheets("Debit Note").Select
Range("G9,G22,G24,G26,G27").Select
ActiveSheet.PasteSpecial

'Supplier Code
Sheets("Cost Gained").Select
ActiveCell.Offset(0, 2).Select
Selection.Copy
Sheets("Debit Note").Select
Range("G10").Select
ActiveSheet.PasteSpecial

'PO Number
Sheets("Cost Gained").Select
ActiveCell.Offset(0, 2).Select
Selection.Copy
Sheets("Debit Note").Select
Range("G7").Select
ActiveSheet.PasteSpecial

'Suppplier Email
Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("G15").Select
ActiveSheet.PasteSpecial

'Address
 Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("C9").Select
ActiveSheet.PasteSpecial

 Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("C10").Select
ActiveSheet.PasteSpecial

 Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("C11").Select
ActiveSheet.PasteSpecial

 Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("C12").Select
ActiveSheet.PasteSpecial

 Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("C13").Select
ActiveSheet.PasteSpecial

 Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("C14").Select
ActiveSheet.PasteSpecial

 Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("C15").Select
ActiveSheet.PasteSpecial

Range("G9").NumberFormat = "$#,##0.00"

Range("G15").Select
Selection.Style = "Hyperlink"

This contains code to add bold around an area, change font to arial size 16. 
But is very long so I have left it out.

'Save as pdf once finish one row, then save pdf in a location then continue until row 299.
    Sheets("Debit Note").Select
    ChDir "P:\Perkins\Quality\COPQ\J Benge COPQ\MACROS\Debit Notes\"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "P:\Perkins\Quality\COPQ\J Benge COPQ\MACROS\Debit Notes\" & Range("G8").Value
    'Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
    :=False, OpenAfterPublish:=False

Sheets("Cost Gained").Select

ActiveCell.Select
ActiveCell.Offset(1, -17).Select
Do Until ActiveCell.EntireRow.Hidden = False
ActiveCell.Offset(1, 0).Select
Loop
Loop Until ActiveCell.Row = "299"

End Sub

Upvotes: 0

Views: 165

Answers (3)

Uri Goren
Uri Goren

Reputation: 13692

Just add these two lines at the beginning of Input_Template()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

And add these two lines before the End Sub

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Upvotes: 1

Darren Bartrup-Cook
Darren Bartrup-Cook

Reputation: 19767

As you're not using any of the PasteSpecial paste types (such as xlPasteValues) then you could just use: 

ThisWorkbook.Worksheets("Cost Gained").Cells(1, 2).Copy _
    Destination:=ThisWorkbook.Worksheets("Debit Note").Cells(2, 1)

This copies from range B1 ( .Cells(1,2) - row 1, column 2) to A2 ( .cells(2,1) - row 2, column 1).

Upvotes: 0

Tim Schmidt
Tim Schmidt

Reputation: 1307

You shoul get rid of the .Select and Selection. you don´t need them, they slow down code and can cause errors.

For Example:

Instead of

Sheets("Debit Note").Select
Range("G11").Select
ActiveSheet.PasteSpecial

You can write

Sheets("Debit Note").Range("G11").PasteSpecial

Upvotes: 1

Related Questions