Speed up my code?

J

jonathann3891

Board Regular
Joined
Apr 27, 2015
Messages
109
This macro takes a few seconds to complete.

I'm sure there is a much simpler and faster way to do the copy & paste section and make it much faster.


Code: 
Sub sbFWP_Import()

Application.ScreenUpdating = False


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Unhide Import Sheet
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Worksheets("Import").Visible = True


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Goto Import Sheet
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Sheets("Import").Select


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Calculate Pile Cut off Elev
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
Range("F1:F" & LastRow).Formula = "=E1/2+D1"
Range(Cells(LastRow + 1, "F"), Cells(Rows.Count, "F")).ClearContents




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Sort Pile Data
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


sbSort


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Paste FWP Pile Data to Sheets
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Sheets("Sheet 1").Select


Sheets("Import").Range("A1:A60").Copy
Sheets("Sheet 1").Range("C3:C62").PasteSpecial xlPasteValues
Sheets("Import").Range("B1:B60").Copy
Sheets("Sheet 1").Range("F3:F62").PasteSpecial xlPasteValues
Sheets("Import").Range("C1:C60").Copy
Sheets("Sheet 1").Range("E3:E62").PasteSpecial xlPasteValues
Sheets("Import").Range("F1:F60").Copy
Sheets("Sheet 1").Range("G3:G62").PasteSpecial xlPasteValues
Cells(3, 5).Select




Sheets("Sheet 2").Select


Sheets("Import").Range("A61:A120").Copy
Sheets("Sheet 2").Range("C3:C62").PasteSpecial xlPasteValues
Sheets("Import").Range("B61:B120").Copy
Sheets("Sheet 2").Range("F3:F62").PasteSpecial xlPasteValues
Sheets("Import").Range("C61:C120").Copy
Sheets("Sheet 2").Range("E3:E62").PasteSpecial xlPasteValues
Sheets("Import").Range("F61:F120").Copy
Sheets("Sheet 2").Range("G3:G62").PasteSpecial xlPasteValues
Cells(3, 5).Select


Sheets("Sheet 3").Select


Sheets("Import").Range("A121:A180").Copy
Sheets("Sheet 3").Range("C3:C62").PasteSpecial xlPasteValues
Sheets("Import").Range("B121:B180").Copy
Sheets("Sheet 3").Range("F3:F62").PasteSpecial xlPasteValues
Sheets("Import").Range("C121:C180").Copy
Sheets("Sheet 3").Range("E3:E62").PasteSpecial xlPasteValues
Sheets("Import").Range("F121:F180").Copy
Sheets("Sheet 3").Range("G3:G62").PasteSpecial xlPasteValues
Cells(3, 5).Select


Sheets("Sheet 4").Select


Sheets("Import").Range("A181:A240").Copy
Sheets("Sheet 4").Range("C3:C62").PasteSpecial xlPasteValues
Sheets("Import").Range("B181:B240").Copy
Sheets("Sheet 4").Range("F3:F62").PasteSpecial xlPasteValues
Sheets("Import").Range("C181:C240").Copy
Sheets("Sheet 4").Range("E3:E62").PasteSpecial xlPasteValues
Sheets("Import").Range("F181:F240").Copy
Sheets("Sheet 4").Range("G3:G62").PasteSpecial xlPasteValues
Cells(3, 5).Select


Sheets("Sheet 5").Select


Sheets("Import").Range("A241:A300").Copy
Sheets("Sheet 5").Range("C3:C62").PasteSpecial xlPasteValues
Sheets("Import").Range("B241:B300").Copy
Sheets("Sheet 5").Range("F3:F62").PasteSpecial xlPasteValues
Sheets("Import").Range("C241:C300").Copy
Sheets("Sheet 5").Range("E3:E62").PasteSpecial xlPasteValues
Sheets("Import").Range("F241:F300").Copy
Sheets("Sheet 5").Range("G3:G62").PasteSpecial xlPasteValues
Cells(3, 5).Select


Sheets("Sheet 6").Select


Sheets("Import").Range("A301:A360").Copy
Sheets("Sheet 6").Range("C3:C62").PasteSpecial xlPasteValues
Sheets("Import").Range("B301:B360").Copy
Sheets("Sheet 6").Range("F3:F62").PasteSpecial xlPasteValues
Sheets("Import").Range("C301:C360").Copy
Sheets("Sheet 6").Range("E3:E62").PasteSpecial xlPasteValues
Sheets("Import").Range("F301:F360").Copy
Sheets("Sheet 6").Range("G3:G62").PasteSpecial xlPasteValues
Cells(3, 5).Select


Sheets("Sheet 7").Select


Sheets("Import").Range("A361:A420").Copy
Sheets("Sheet 7").Range("C3:C62").PasteSpecial xlPasteValues
Sheets("Import").Range("B361:B420").Copy
Sheets("Sheet 7").Range("F3:F62").PasteSpecial xlPasteValues
Sheets("Import").Range("C361:C420").Copy
Sheets("Sheet 7").Range("E3:E62").PasteSpecial xlPasteValues
Sheets("Import").Range("F361:F420").Copy
Sheets("Sheet 7").Range("G3:G62").PasteSpecial xlPasteValues
Cells(3, 5).Select


Sheets("Sheet 8").Select


Sheets("Import").Range("A421:A480").Copy
Sheets("Sheet 8").Range("C3:C62").PasteSpecial xlPasteValues
Sheets("Import").Range("B421:B480").Copy
Sheets("Sheet 8").Range("F3:F62").PasteSpecial xlPasteValues
Sheets("Import").Range("C421:C480").Copy
Sheets("Sheet 8").Range("E3:E62").PasteSpecial xlPasteValues
Sheets("Import").Range("F421:F480").Copy
Sheets("Sheet 8").Range("G3:G62").PasteSpecial xlPasteValues
Cells(3, 5).Select


Sheets("Sheet 9").Select


Sheets("Import").Range("A481:A540").Copy
Sheets("Sheet 9").Range("C3:C62").PasteSpecial xlPasteValues
Sheets("Import").Range("B481:B540").Copy
Sheets("Sheet 9").Range("F3:F62").PasteSpecial xlPasteValues
Sheets("Import").Range("C481:C540").Copy
Sheets("Sheet 9").Range("E3:E62").PasteSpecial xlPasteValues
Sheets("Import").Range("F481:F540").Copy
Sheets("Sheet 9").Range("G3:G62").PasteSpecial xlPasteValues
Cells(3, 5).Select


Sheets("Sheet 10").Select


Sheets("Import").Range("A541:A600").Copy
Sheets("Sheet 10").Range("C3:C62").PasteSpecial xlPasteValues
Sheets("Import").Range("B541:B600").Copy
Sheets("Sheet 10").Range("F3:F62").PasteSpecial xlPasteValues
Sheets("Import").Range("C541:C600").Copy
Sheets("Sheet 10").Range("E3:E62").PasteSpecial xlPasteValues
Sheets("Import").Range("F541:F600").Copy
Sheets("Sheet 10").Range("G3:G62").PasteSpecial xlPasteValues
Cells(3, 5).Select


Sheets("Sheet 11").Select


Sheets("Import").Range("A601:A660").Copy
Sheets("Sheet 11").Range("C3:C62").PasteSpecial xlPasteValues
Sheets("Import").Range("B601:B660").Copy
Sheets("Sheet 11").Range("F3:F62").PasteSpecial xlPasteValues
Sheets("Import").Range("C601:C660").Copy
Sheets("Sheet 11").Range("E3:E62").PasteSpecial xlPasteValues
Sheets("Import").Range("F601:F660").Copy
Sheets("Sheet 11").Range("G3:G62").PasteSpecial xlPasteValues
Cells(3, 5).Select




Sheets("Sheet 12").Select


Sheets("Import").Range("A661:A720").Copy
Sheets("Sheet 12").Range("C3:C62").PasteSpecial xlPasteValues
Sheets("Import").Range("B661:B720").Copy
Sheets("Sheet 12").Range("F3:F62").PasteSpecial xlPasteValues
Sheets("Import").Range("C661:C720").Copy
Sheets("Sheet 12").Range("E3:E62").PasteSpecial xlPasteValues
Sheets("Import").Range("F661:F720").Copy
Sheets("Sheet 12").Range("G3:G62").PasteSpecial xlPasteValues
Cells(3, 5).Select


Sheets("Sheet 13").Select


Sheets("Import").Range("A721:A780").Copy
Sheets("Sheet 13").Range("C3:C62").PasteSpecial xlPasteValues
Sheets("Import").Range("B721:B780").Copy
Sheets("Sheet 13").Range("F3:F62").PasteSpecial xlPasteValues
Sheets("Import").Range("C721:C780").Copy
Sheets("Sheet 13").Range("E3:E62").PasteSpecial xlPasteValues
Sheets("Import").Range("F721:F780").Copy
Sheets("Sheet 13").Range("G3:G62").PasteSpecial xlPasteValues
Cells(3, 5).Select


Sheets("Sheet 14").Select


Sheets("Import").Range("A781:A840").Copy
Sheets("Sheet 14").Range("C3:C62").PasteSpecial xlPasteValues
Sheets("Import").Range("B781:B840").Copy
Sheets("Sheet 14").Range("F3:F62").PasteSpecial xlPasteValues
Sheets("Import").Range("C781:C840").Copy
Sheets("Sheet 14").Range("E3:E62").PasteSpecial xlPasteValues
Sheets("Import").Range("F781:F840").Copy
Sheets("Sheet 14").Range("G3:G62").PasteSpecial xlPasteValues
Cells(3, 5).Select


Sheets("Sheet 15").Select


Sheets("Import").Range("A841:A900").Copy
Sheets("Sheet 15").Range("C3:C62").PasteSpecial xlPasteValues
Sheets("Import").Range("B841:B900").Copy
Sheets("Sheet 15").Range("F3:F62").PasteSpecial xlPasteValues
Sheets("Import").Range("C841:C900").Copy
Sheets("Sheet 15").Range("E3:E62").PasteSpecial xlPasteValues
Sheets("Import").Range("F841:F900").Copy
Sheets("Sheet 15").Range("G3:G62").PasteSpecial xlPasteValues
Cells(3, 5).Select




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Goto Sheet 1, Select Cell E3
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Sheets("Sheet 1").Select
Cells(3, 5).Select


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Hide Import Sheet
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Worksheets("Import").Visible = False


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Clear Import Sheet
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


'Sheets("Import").Cells.ClearContents




End Sub
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Sort by date Sort by votes
Since you are copying values, you can replace the Copy and Paste with:
Code: 
Sheets("Sheet 1").Range("C3:C62").Value = Sheets("Import").Range("A1:A60").Value
Sheets("Sheet 1").Range("F3:F62").Value = Sheets("Import").Range("B1:B60").Value
Sheets("Sheet 1").Range("E3:E62").Value = Sheets("Import").Range("C1:C60").Value
Sheets("Sheet 1").Range("G3:G62").Value = Sheets("Import").Range("F1:F60").Value
And the Sheets and Cells Select statements aren't needed.
 
Upvote 0
I would recommend taking an approach like this. It avoids the Select statement as well as hiding and unhiding the "Import" sheet. Select in particular is a very slow statement that should generally be avoided if at all possible. This code also is much shorter and more readable since it loops over the sheets instead of having individual code for each one. Also, if you ever need to add another sheet, you can just change the 15 to 16 (or any other number you need) and you won't have to do anything else to the code. See if this helps any.

Code: 
Sub sbFWP_Import()
    Dim LastRow As Long, i As Long, CopyRow As Long, ws As Worksheet

    Application.ScreenUpdating = False

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Calculate Pile Cut off Elev
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    With Sheets("Import")
        LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        Range(.Cells(1, "F"), .Cells(LastRow, "F")).Formula = "=E1/2+D1"
        Range(.Cells(LastRow + 1, "F"), .Cells(Rows.Count, "F")).ClearContents
    End With

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Sort Pile Data
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    sbSort

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Paste FWP Pile Data to Sheets
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    CopyRow = 1
    For i = 1 To 15
        Set ws = Sheets("Sheet " & i)
        With Sheets("Import")
            Range(.Cells(CopyRow, "A"), .Cells(CopyRow + 59, "A")).Copy
            ws.Range("C3:C62").PasteSpecial xlPasteValues
            Range(.Cells(CopyRow, "B"), .Cells(CopyRow + 59, "B")).Copy
            ws.Range("F3:F62").PasteSpecial xlPasteValues
            Range(.Cells(CopyRow, "C"), .Cells(CopyRow + 59, "C")).Copy
            ws.Range("E3:E62").PasteSpecial xlPasteValues
            Range(.Cells(CopyRow, "F"), .Cells(CopyRow + 59, "F")).Copy
            ws.Range("G3:G62").PasteSpecial xlPasteValues
        End With
        CopyRow = CopyRow + 60
    Next i

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Clear Import Sheet
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'Sheets("Import").Cells.ClearContents
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question
VBA Speed up Copy and paste
Replies
3
Views
380
skillilea
S
VinceF
  • Solved
Code to Disregard VBA or to Execute if Condition Met
Replies
3
Views
69
Alex Blakenburg
A
P
  • Solved
Button produces different result
Replies
3
Views
127
RoryA
RoryA
I
  • Solved
Vba Call function shows subscript out of range
Replies
9
Views
429
ipbr21054
I
I
  • Solved
Sorting a table range using vba
Replies
2
Views
286
ipbr21054
I

Forum statistics

Threads
1,215,216
Messages
6,123,669
Members
449,114
Latest member
aides

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top