Slow Macro

FlashNZ

New Member
Joined
Mar 3, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows
Hi, I have created a Macro that copies specific cells and then pastes the values into other cells on the sheet. Each copy and paste has a specific cell to copy from and paste to.

The Macro runs fine and does what I want it to do but it is very slow.

Any tips on speeding it up would be appreciated?

VBA Code:
Sub CopyRecordedQuote()
'
' CopyInquiry Macro
'
CarryOn = MsgBox("Are you sure you want to copy this Rcorded Quote?", vbYesNo, "Copy Recorded Quote")
If CarryOn = vbYes Then
'put rest of code here
'
'
Sheets("Quotes").Unprotect Password:="2368"

Application.ScreenUpdating = False

'skip all run-time errors
On Error Resume Next

    Range("A57").Select
    Selection.Copy
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C56").Select
    Selection.Copy
    Range("D13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D56").Select
    Selection.Copy
    Range("D15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E56").Select
    Selection.Copy
    Range("D16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G56").Select
    Selection.Copy
    Range("D19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H56").Select
    Selection.Copy
    Range("D20").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("I56").Select
    Selection.Copy
    Range("D21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J56").Select
    Selection.Copy
    Range("D22").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("K56").Select
    Selection.Copy
    Range("D24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("L56").Select
    Selection.Copy
    Range("D25").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("M56").Select
    Selection.Copy
    Range("D26").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("M56").Select
    Selection.Copy
    Range("D26").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("N56").Select
    Selection.Copy
    Range("D28").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("O56").Select
    Selection.Copy
    Range("D29").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("P56").Select
    Selection.Copy
    Range("D31").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Q56").Select
    Selection.Copy
    Range("D36").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("R56").Select
    Selection.Copy
    Range("D38").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("S56").Select
    Selection.Copy
    Range("H8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("T56").Select
    Selection.Copy
    Range("H9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("U56").Select
    Selection.Copy
    Range("H10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("V56").Select
    Selection.Copy
    Range("H13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("W56").Select
    Selection.Copy
    Range("J13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("X56").Select
    Selection.Copy
    Range("K13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Y56").Select
    Selection.Copy
    Range("L13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Z56").Select
    Selection.Copy
    Range("H15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AA56").Select
    Selection.Copy
    Range("J15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AB56").Select
    Selection.Copy
    Range("K15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AC56").Select
    Selection.Copy
    Range("L15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AD56").Select
    Selection.Copy
    Range("H17").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AE56").Select
    Selection.Copy
    Range("J17").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AF56").Select
    Selection.Copy
    Range("K17").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AG56").Select
    Selection.Copy
    Range("L17").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AH56").Select
    Selection.Copy
    Range("H19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AI56").Select
    Selection.Copy
    Range("H21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AJC56").Select
    Selection.Copy
    Range("H24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AK6").Select
    Selection.Copy
    Range("J24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AL56").Select
    Selection.Copy
    Range("L24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AM56").Select
    Selection.Copy
    Range("H27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AN56").Select
    Selection.Copy
    Range("J27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AO56").Select
    Selection.Copy
    Range("H28").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AP56").Select
    Selection.Copy
    Range("J28").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AQ56").Select
    Selection.Copy
    Range("H29").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AR56").Select
    Selection.Copy
    Range("J29").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AS56").Select
    Selection.Copy
    Range("H30").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AT56").Select
    Selection.Copy
    Range("J30").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AU56").Select
    Selection.Copy
    Range("H33").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AV56").Select
    Selection.Copy
    Range("J33").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AW56").Select
    Selection.Copy
    Range("K33").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AX56").Select
    Selection.Copy
    Range("L33").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AY56").Select
    Selection.Copy
    Range("H34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AZ56").Select
    Selection.Copy
    Range("J34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("BA56").Select
    Selection.Copy
    Range("K34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("BB56").Select
    Selection.Copy
    Range("L34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("BC56").Select
    Selection.Copy
    Range("H35").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("BD56").Select
    Selection.Copy
    Range("J35").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("BE56").Select
    Selection.Copy
    Range("K35").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("BF56").Select
    Selection.Copy
    Range("L35").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("BG56").Select
    Selection.Copy
    Range("H36").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("BH56").Select
    Selection.Copy
    Range("J36").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("BI56").Select
    Selection.Copy
    Range("K36").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("BJ56").Select
    Selection.Copy
    Range("L36").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("Quotes").Protect Password:="2368"

  Application.ScreenUpdating = True

'Turn off error trapping and re-allow run time errors
On Error GoTo 0
        
End If
End Sub
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,969
Office Version
  1. 365
Platform
  1. Windows
You can do it like
VBA Code:
    Range("D2").Value = Range("A57").Value
    Range("D13").Value = Range("C56").Value
    Range("D15").Value = Range("D56").Value
which should be faster.
 

FlashNZ

New Member
Joined
Mar 3, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

You can do it like
VBA Code:
    Range("D2").Value = Range("A57").Value
    Range("D13").Value = Range("C56").Value
    Range("D15").Value = Range("D56").Value
which should be faster.
That's certainly faster, thanks a lot.

Any ideas on this one to speed it up? This Macro makes the merged cells fit the text. Once again it works fine but it is very slow.

VBA Code:
Option Explicit
Sub FixMerged() 'Excel VBA to autofit merged cells

ActiveSheet.Unprotect Password:="2368"

Dim mw As Single
Dim cM As Range
Dim Rng As Range
Dim cw As Double
Dim rwht As Double
Dim ar As Variant
Dim i As Integer

Application.ScreenUpdating = False
'Cell Ranges below, change to suit.
ar = Array("C58", "C63", "C65", "B70")

For i = 0 To UBound(ar)
On Error Resume Next
Set Rng = Range(Range(ar(i)).MergeArea.Address)
Rng.MergeCells = False
cw = Rng.Cells(1).ColumnWidth
mw = 0
For Each cM In Rng
cM.WrapText = True
mw = cM.ColumnWidth + mw
Next
mw = mw + Rng.Cells.Count * 0.66
Rng.Cells(1).ColumnWidth = mw
Rng.EntireRow.AutoFit
rwht = Rng.RowHeight
Rng.Cells(1).ColumnWidth = cw
Rng.MergeCells = True
Rng.RowHeight = rwht
Next i
Application.ScreenUpdating = True

ActiveSheet.Protect Password:="2368"

End Sub
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,590
Office Version
  1. 365
Platform
  1. Windows
In relation to the original question ...
The Macro runs fine and does what I want it to do ..
Are you sure?
There are two parts that look 'out of the ordinary' to me.

All your values are copied for row 56 (& 57 for the first one) but in the middle of your code you are copying from row 6, not row 56.
Also, you have one line where you are copying from column AJC. Wondering if that is also a mistake and it should be just column AJ?

In my code below I have left those references as you had them but marked the code lines in case they need attention.

My suggestion is that instead of copying 60+ individual cell values, some of them could be done in groups by a couple of different methods.
Roughly speaking this about halves the number of 'transactions' required.

VBA Code:
Range("D2").Value = Range("A57").Value
Range("D13").Value = Range("C56").Value
Range("D15:D16").Value = Application.Transpose(Range("D56:E56").Value)
Range("D19:D22").Value = Application.Transpose(Range("G56:J56").Value)
Range("D24:D26").Value = Application.Transpose(Range("K56:M56").Value)
Range("D28:D29").Value = Application.Transpose(Range("N56:O56").Value)
Range("D31").Value = Range("P56").Value
Range("D36").Value = Range("Q56").Value
Range("D38").Value = Range("R56").Value
Range("H8:H10").Value = Application.Transpose(Range("S56:U56").Value)
Range("H13").Value = Range("V56").Value
Range("J13:L13").Value = Range("W56:Y56").Value
Range("H15").Value = Range("Z56").Value
Range("J15:L15").Value = Range("AA56:AC56").Value
Range("H17").Value = Range("AD56").Value
Range("J17:L17").Value = Range("AE56:AG56").Value
Range("H19").Value = Range("AH56").Value
Range("H21").Value = Range("AI56").Value
Range("H24").Value = Range("AJC56").Value '???????????????
Range("J24").Value = Range("AK6").Value   '???????????????
Range("L24").Value = Range("AL56").Value

Range("AM56,AO56,AQ56,AS56").Copy
Range("H27").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Range("AN56,AP56,AR56,AT56").Copy
Range("J27").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Range("AU56,AY56,BC56,BG56").Copy
Range("H33").PasteSpecial Paste:=xlPasteValues, Transpose:=True

Range("J33:L33").Value = Range("AV56:AX56").Value
Range("J34:L34").Value = Range("AZ56:BB56").Value
Range("J35:L35").Value = Range("BD56:BF56").Value
Range("J36:L36").Value = Range("BH56:BJ56").Value
 

FlashNZ

New Member
Joined
Mar 3, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows
Thanks, that is better and yes there were a couple of typo's in there.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,590
Office Version
  1. 365
Platform
  1. Windows
You're welcome. Glad to contribute. :)
 

Watch MrExcel Video

Forum statistics

Threads
1,130,342
Messages
5,641,592
Members
417,224
Latest member
llama9207

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
Top