0

The full code is listed below, I'm copying and data from cell DB10 from the PivotTables sheet to column N in the Checklists sheet - also note that the rows in the Checklists sheet is dynamic and grows by 3018 rows each weekly...this is the part that slows down the processign time (I timed it and it takes ~8 minutes to complete processing when running the code) This part is where things slow down:

Sheets("PivotTables").Select
    Range("DB10").Select
    Selection.Copy
       Sheets("Checklists").Select
          Dim rng As Range
            NRowCount = Cells(Rows.Count, 1).End(xlUp).Offset(-3017).Row
              ARowCount = Cells(Rows.Count, 1).End(xlUp).Row
                For Each rng In Range("N" & NRowCount & ":N" & ARowCount)
                   rng.PasteSpecial xlPasteValues
                       Next rng

Full code:

Sub WeeklyUpdate()
Application.ScreenUpdating = False
'
' WeeklyUpdate Macro
'

'


    Sheets("Checklists").Select
    Dim LR As Long

    LR = Range("A" & Rows.Count).End(xlUp).Row
    Range("A3:M" & LR).SpecialCells(xlCellTypeVisible).Select
'
    Selection.Copy
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    Sheets("Checklists").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial 
    xlPasteValues
    Sheets("Checklists").AutoFilterMode = False
    Sheets("PivotTables").Select
    Range("DB10").Select
    Selection.Copy
    Sheets("Checklists").Select
    Dim rng As Range
    NRowCount = Cells(Rows.Count, 1).End(xlUp).Offset(-3017).Row
    ARowCount = Cells(Rows.Count, 1).End(xlUp).Row
    For Each rng In Range("N" & NRowCount & ":N" & ARowCount)
    rng.PasteSpecial xlPasteValues
    Next rng

    Sheets("Home").Select

    Application.ScreenUpdating = True

    End Sub
Damon. Martin
  • 11
  • 1
  • 4
  • Have a look at this link as a different quicker method is shown. http://www.excelitems.com/2010/12/optimize-vba-code-for-faster-macros.html – Solar Mike May 03 '18 at 20:15
  • see also https://stackoverflow.com/questions/23937262/excel-vba-copy-paste-values-only-xlpastevalues please use the search feature for finding similar questions. Pasting values is a common question here, and there are dozens or hundreds of solutions that you can adapt for your needs. Cheers. – David Zemens May 03 '18 at 21:00
  • Thanks David and Solar, I'm looking through other examples - I'm very light on VBA skills so it's possible the answer has been right tin front of me many times through my searches but I simply didn't understand the code well enough to catch it. -Thanks for the links. – Damon. Martin May 04 '18 at 14:04

1 Answers1

1

If I'm understanding correctly, you're just pasting the value in cell DB10 into the range N[NRowCount]:N[ARowCount].

Rather than doing a For loop, just try something along the lines of:

Range("N" & NRowCount & ":N" & ARowCount).Value = Range("DB10").Value

It eliminates the loop and should be immediate.

Your final code would look roughly as follows:

...
Sheets("Checklists").AutoFilterMode = False
Sheets("Checklists").Range("N" & NRowCount & ":N" & ARowCount).Value = Sheets("PivotTables").Range("DB10").Value
Sheets("Home").Select
John Bustos
  • 19,036
  • 17
  • 89
  • 151
  • Hi John, thanks for the answer, you are correct, I'm trying to copy what's in cell DB10 from the PivotTables sheet into column N on the Checklists sheet. I tried the code you provide and it errors out at the second line of the code you provided. – Damon. Martin May 04 '18 at 14:02
  • What do you mean by the second line @Damon.Martin? - I just showed you what it should look like, the only line you need is that `.Value = .Value` line. I was just trying to show you where it could go in YOUR code - The second and fourth line are from your original posted code. – John Bustos May 04 '18 at 14:32
  • Hi John, I'm speaking in regards to the .value = .value that I added (replaced the original code starting at Sheets("PivotTables").Select Range("DB10").Select Selection.Copy Sheets("Checklists").Select Dim rng As Range NRowCount = Cells(Rows.Count, 1).End(xlUp).Offset(0).Row ARowCount = Cells(Rows.Count, 1).End(xlUp).Row For Each rng In Range("N" & NRowCount & ":N" & ARowCount) rng.PasteSpecial xlPasteValues Next rng – Damon. Martin May 04 '18 at 14:57
  • @Damon.Martin, did you define `NRowCount` and `ARowCount` somewhere else then? – John Bustos May 04 '18 at 15:48
  • no, I don't have NRowCount and ARowCount anywhere else – Damon. Martin May 04 '18 at 16:53