Slow Macro

FlashNZ

New Member
Joined
Mar 3, 2021
Messages
29
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

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
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.
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
Thanks, that is better and yes there were a couple of typo's in there.
 
Upvote 0

Forum statistics

Threads
1,212,933
Messages
6,110,751
Members
448,295
Latest member
Uzair Tahir Khan

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