Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 301
  • Last Modified:

Copy and Paste in a macro is slow can anyone demonstrate quicker code.

I have a very large macro which used a copy and paste code several times while looping through a very large spreadsheet. Attached is a simulated worksheet with a working macro. Can anyone show me how to change the code so the time taken could be reduced. Any assistence would be appreciated.

THANKS
Copy-N-Paste.xlsm
0
user2073
Asked:
user2073
  • 6
  • 4
1 Solution
 
NorieData ProcessorCommented:
One thing you could do is get rid of all the Selects.

I'd post code illustrating exactly how to do that but becuase of the use of Select and ActiveCell it makes it hard to follow what's going on in the code.

Perhaps if you explained in words what it's meant to do it might help.
0
 
NorieData ProcessorCommented:
I managed to figure it out apart from the last bit - couldn't work out which cell we would end up in on Sheet2.
Sub Copy_N_Paste()
Dim rngDst As Range
Dim rngSrc As Range

    'Testing macro for Copy & Paste plus adding formulas.

    Application.ScreenUpdating = False

    Set rngDst = Sheets("Sheet2").Range("C5")
    Set rngSrc = Sheets("Sheet1").Range("A4")

    Do While Not IsEmpty(rngSrc)

        rngSrc.Copy
        'The line below is an alternative code - Places the data in columns next to each other.
        '    ActiveCell.Offset(0, 0).Range("A1, F1, H1").Select

        rngDst.PasteSpecial Paste:=xlPasteValues

        rngSrc.Offset(0, 5).Copy

        rngDst.Offset(0, 3).PasteSpecial Paste:=xlPasteValues

        rngSrc.Offset(0, 7).Copy
        rngDst.Offset(0, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        With rngDst.Offset(0, 7)
            .Value = Now
            .NumberFormat = "dd/mm/yyyy hh:mm"
        End With

        Set rngDst = rngDst.Offset(1)
        Set rngSrc = rngSrc.Offset(1)
    Loop

    Sheets("Sheet2").Select
    ActiveCell.Select
    ActiveCell.Offset(1, 5).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Time Taken"
    ActiveCell.Offset(0, 2).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=R[-2]C-R[-7]C"
    ActiveCell.Select
    Selection.NumberFormat = "h:mm:ss.000"

    Application.ScreenUpdating = True

    Sheets("Sheet1").Select
    Range("A4").Select

End Sub

Open in new window

0
 
user2073Author Commented:
Using words to explain the process would go something like the following:

From "Sheet1" I need to copy values only from columns "A", "F" & "H".
then paste them in "Sheet2" using columns "C", "F" & "H".
I need to remove any formulas used I also want to use a formula in column "J" and remove any formula also. This sample is only a simplified type of workings I need. As for the use of Select and ActiveCell that has occurred as a result of recording a macro, which demonstrates limitations in my knowledge.

SORRY
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
user2073Author Commented:
Your code works fantastic, Thanks. I'll work with it over the weekend and respond early next week. Sorry for the delay, I need to use it in the very much larger spreadsheet. Once I figure out the language it should be able to reduce the processing time significantly..

Many Thanks
0
 
NorieData ProcessorCommented:
It can probably be improved.

For example, if you are copying whole columns of data, which I think you might be, it could be done without a loop.

I didn't change the code to reflect that though as I wanted to keep it close to the original.

Here it is though.
Sub Copy_N_Paste()
Dim rngDst As Range
Dim rngSrc As Range
Dim LastRow As Long

    LastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

    'Testing macro for Copy & Paste plus adding formulas.

    Application.ScreenUpdating = False

    Set rngDst = Sheets("Sheet2").Range("C5")
    Set rngSrc = Sheets("Sheet1").Range("A4:A" & LastRow)

    rngSrc.Copy
    rngDst.PasteSpecial xlPasteValues

    rngSrc.Offset(, 5).Copy
    rngDst.Offset(, 3).PasteSpecial xlPasteValues

    rngSrc.Offset(, 7).Copy
    rngDst.Offset(, 5).PasteSpecial xlPasteValues
    
    With rngDst.Offset(, 7).Resize(LastRow - rngSrc.Row + 1)
          .Value = Now()
          .NumberFormat = "dd/mm/yyyy hh:mm"
    End With
    
End Sub

Open in new window

0
 
user2073Author Commented:
This last piece of code may work in my application but because I have several extra coulmns with formulas in them it may not be the best process but i'll give them both a go over the weekend. By the way it understanding most of what you have written and its looking real good. I'll let you no.

Many Thanks
0
 
user2073Author Commented:
How do I format the code below.

rngSrc.Offset(, 2).Copy
rngDst.Offset(LastRow, 5).PasteSpecial xlPasteValues

I have tried the below without any success.

Selection.NumberFormat = "m/d/yyyy"
            With Selection
                .HorizontalAlignment = xlRight
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With

Can someone help?

THANKS
0
 
NorieData ProcessorCommented:
Try replacing xlPasteValues with xlPasteValuesAndNumberFormats.

That's will only work in later versions but if it does all you will need are the Copy and PasteSpecial lines.
0
 
user2073Author Commented:
The change in the are working but the alignment is different in the cell.
Also, how do I add a formula such as "If Statement".

Your method of coding has change a working macro into whole new direction, which is fantastic. I'm still working on this current project because of your assistence were making good progress. Hopefully I will be completed on Monday.

Many Thanks
0
 
user2073Author Commented:
Sorry for taking so long to complete this request. I needed to keep this request open until I was near to completion of this exercise.

Your code has always worked unfortunately I needed to resolve a few other issues, Thanks.
I'll be using your code.

rngDst.Offset(LastRow, 8).Resize(rngSrc.Rows.Count).NumberFormat = "0.0"

You guys are appreciated because without you I would not develope better skills.

THANKS
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 6
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now