How do I increase the speen of my Macro to copy/paste data.

[CoolioDude]

Hi, I have created this macro which is copy/pasting values (Hardcoding) them so that no one can change the numbers but it is slowing down the macro when performing this function as it is going thru several tabs and doing the same. below is the follow thru of the macro coding.

Sub AllSheetsPrep()
'
' This will set up sheets appearance for user''''
'MyArea = Array("Total Company", "Retail", "Logistics", "IS", "HR", "Finance", "Executive", "By Div FY Forecast", "By Div FY Forecast Variance")
MyArea = Array("Branch Administration", "Warehouse Full Goods", "Warehouse Empties", "City Delivery", "Stock Transfer Full Goods", "Stock Transfer Empties", _
"Sorting", "Bottle Depots", "Premises", "Can Densifying", "LTL FG", "LTL MT", "Contracted CD", "Contracted CD 35", "Stk Tsf FG Intra", "Stk Tsf FG Inter", "Stk Tsf MT Intra", _
"Stk Tsf MT Inter", "Agent Handling Fee", "Agent Can Densifying", "Other Revenue", "Provincial Admin", "IT", "Finance", "HR", "Executive", "Logistics", "Customer Service", "9800 Reallocations", "Total Operation")

For Each I In MyArea
Application.StatusBar = "Hardcoding values - sheet " & I & ", please wait....."
Sheets("" & I).Select
ActiveSheet.Unprotect
Selection.AutoFilter

'''run subroutine
'''Hard coding the values so that no formulas are corrupted.''''

CopyPasteData

Range("a5").Select
If ActiveCell.Value = 494 Then
'Sheets("" & I).Visible = False
ActiveWindow.SelectedSheets.Visible = False
Else
hidelines
End If
Next I
Sheets("File Inputs").Select
End Sub




Sub CopyPasteData()
'Macro recorded 3/23/11 by Apatel.
'This macro will hardcode all formulas to values only.'''
ActiveSheet.Unprotect
Cells.Select
Selection.EntireRow.Hidden = False
Range("B8:W21").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B23:W46").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B48:W48").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B50:W63").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B65:W69").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B71:W77").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B79:W79").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B81:W81").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B83:W95").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B97:W98").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B100:W121").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B123:W131").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B133:W133").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B135:W141").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B143:W149").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B151:W161").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B163:W163").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B165:W165").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B167:W167").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B169:W169").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B171:W171").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B173:W182").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B184:W209").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B211:W211").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B213:W226").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B228:W236").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B238:W246").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B248:W248").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B250:W278").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B280:W280").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B282:W308").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B310:W315").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B317:W323").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B325:W326").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B328:W329").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B331:W332").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B334:W334").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B336:W340").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B342:W350").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B352:W352").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B354:W366").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B368:W369").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B371:W371").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B373:W373").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B375:W375").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B377:W377").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B379:W379").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B381:W393").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B395:W399").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B401:W402").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B404:W406").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B408:W408").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B410:W418").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B420:W421").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B423:W445").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B447:W463").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B465:W479").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B481:W485").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B487:W488").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B490:W490").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B492:W498").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B500:W500").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

End Sub
Sub Freight()
'This macro saves file with tabs for Freight Only.'''
MyArea = Array("Branch Administration", "Warehouse Full Goods", "Warehouse Empties", "City Delivery", "Stock Transfer Full Goods", "Stock Transfer Empties", _
"Sorting", "Bottle Depots", "Premises", "Can Densifying", _
"Agent Handling Fee", "Agent Can Densifying", "Agent Handling Fee", "Other Revenue", "Provincial Admin", "IT", "Finance", "HR", "Executive", "Logistics", "Customer Service", "9800 Reallocations", "Detail Of All Accts", "Ownership Table of Accts")

For Each I In MyArea
Application.StatusBar = "Creating Freight file - sheet " & I & ", please wait....."

If Sheets("" & I).Visible = True Then
Sheets("" & I).Select
ActiveWindow.SelectedSheets.Visible = False
Else
End If
Next I


Sheets("File Inputs").Select


End Sub


Can this process be improved to shorten the time it takes for it to copy and paste data?

Thank you.

 

[Cindy Ellis]

You posted a lot of code...it will be easier in the future if you surround it with code tags "[" CODE "]" AND "[\" CODE "]" (without all the quotes and spaces).
There are many improvements that will speed this up.
Just taking one bit of your code that's repeated many times:

[COLOR=black]Cells.Select[/COLOR]
[COLOR=black]Selection.EntireRow.Hidden = False[/COLOR]
[COLOR=black]Range("B8:W21").Select[/COLOR]
[COLOR=black]Selection.Copy[/COLOR]
[COLOR=black]Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _[/COLOR]
[COLOR=black]False, Transpose:=False[/COLOR]
[COLOR=black]Application.CutCopyMode = False[/COLOR]

can be compressed into:

With ActiveSheet.Range("B8:W21")
    .Copy
    .PasteSpecial Paste:=xlValues
End With

Or, if you don't want any formulas kept, just apply it to the whole sheet at the same time. Cells that don't have formulas to start with won't be affected.
Basically, you want to avoid "select" as much as possible.
Hope that helps,
Cindy

 

[MrKowz]

Welcome to the forums!

Are you wanting to take ALL formulas on that sheet and replace them with their values? If so, that code can be drastically reduced.

 

[CoolioDude]

Welcome to the forums!

Are you wanting to take ALL formulas on that sheet and replace them with their values? If so, that code can be drastically reduced.

Hi Mr Kowz,

I want to reduce the repetition of the coding for copy and pasting to get rid of the formulas. At the end of each set of the rows I have subtotals that I want to keep so that when new data is inserted in those rows the subtotals get updated immediately.

Thank you for the help.

 

[Boller]

..

 

[MrKowz]

Hi Mr Kowz,

I want to reduce the repetition of the coding for copy and pasting to get rid of the formulas. At the end of each set of the rows I have subtotals that I want to keep so that when new data is inserted in those rows the subtotals get updated immediately.

Thank you for the help.

Try replacing your second code (the LONG copy/paste one) with:

Public Sub CopyPasteData()
Dim rng As Range, _
    LC  As Long, _
    LR  As Long
    
LR = Range("A" & rows.Count).End(xlUp).row
LC = Cells(1, Columns.Count).End(xlToLeft).column
ActiveSheet.Unprotect
Cells.EntireRow.Hidden = False
Application.ScreenUpdating = False
For Each rng In Range(Cells(1, 1), Cells(LR, LC - 1)).SpecialCells(xlCellTypeFormulas)
    rng.Value = rng.Value
Next rng
Application.ScreenUpdating = True
End Sub

It will change every formula in the spreadsheet (except for the formulas in the last column) to values.

Be sure to back up your spreadsheet before running macros.

 

[CoolioDude]

Try replacing your second code (the LONG copy/paste one) with:

Public Sub CopyPasteData()
Dim rng As Range, _
    LC  As Long, _
    LR  As Long
 
LR = Range("A" & rows.Count).End(xlUp).row
LC = Cells(1, Columns.Count).End(xlToLeft).column
ActiveSheet.Unprotect
Cells.EntireRow.Hidden = False
Application.ScreenUpdating = False
For Each rng In Range(Cells(1, 1), Cells(LR, LC - 1)).SpecialCells(xlCellTypeFormulas)
    rng.Value = rng.Value
Next rng
Application.ScreenUpdating = True
End Sub

It will change every formula in the spreadsheet (except for the formulas in the last column) to values.

Be sure to back up your spreadsheet before running macros.

This code does not seem to work as it is not picking up the the rows and columns to to change the formulas into hardcoded values.

Is there another way as my subtotal row is in each of the columns from Column 'C' to column 'W'. I want the code to select the rows and columns to copy and paste values only therefore coverting the formulas into hard coded values.

 

[MrKowz]

This code does not seem to work as it is not picking up the the rows and columns to to change the formulas into hardcoded values.

Is there another way as my subtotal row is in each of the columns from Column 'C' to column 'W'. I want the code to select the rows and columns to copy and paste values only therefore coverting the formulas into hard coded values.

It should be reading where your last row and last column are located.

What row on your spreadsheet will always have data that extends to the last column (like a header row)?

 

[CoolioDude]

It should be reading where your last row and last column are located.

What row on your spreadsheet will always have data that extends to the last column (like a header row)?

All the sheets have headers on row 7 and data is filled below it starting from row 8 all the way down to row 501. Also for your info, column B has breaks on rows that contain subtotals running across in each column until Column 'W'. My column 'A' counts the columns that contain zeros. This is used to hide the rows that do not contain any data.

 

[MrKowz]

Now we're getting somewhere -

You say that column B has breaks where there are subtotals, does that mean that where there is a blank on column B, there will be a subtotal line on that same row?

Ie...
<b>Excel 2003</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><colgroup><col width="25px" style="background-color: #E0E0F0" /><col /><col /><col /><col /></colgroup><thead><tr style=" background-color: #E0E0F0;text-align: center;color: #161120"><th></th><th>B</th><th>C</th><th>D</th><th>E</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">2</td><td style=";">data</td><td style=";">data</td><td style=";">data</td><td style=";">data</td></tr><tr ><td style="color: #161120;text-align: center;">3</td><td style=";">data</td><td style=";">data</td><td style=";">data</td><td style=";">data</td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style=";">data</td><td style=";">data</td><td style=";">data</td><td style=";">data</td></tr><tr ><td style="color: #161120;text-align: center;">5</td><td style=";">data</td><td style=";">data</td><td style=";">data</td><td style=";">data</td></tr><tr ><td style="color: #161120;text-align: center;">6</td><td style=";">data</td><td style=";">data</td><td style=";">data</td><td style=";">data</td></tr><tr ><td style="color: #161120;text-align: center;">7</td><td style="text-align: right;;"></td><td style=";">subtotal</td><td style=";">subtotal</td><td style=";">subtotal</td></tr><tr ><td style="color: #161120;text-align: center;">8</td><td style=";">data</td><td style=";">data</td><td style=";">data</td><td style=";">data</td></tr><tr ><td style="color: #161120;text-align: center;">9</td><td style=";">data</td><td style=";">data</td><td style=";">data</td><td style=";">data</td></tr><tr ><td style="color: #161120;text-align: center;">10</td><td style=";">data</td><td style=";">data</td><td style=";">data</td><td style=";">data</td></tr><tr ><td style="color: #161120;text-align: center;">11</td><td style=";">data</td><td style=";">data</td><td style=";">data</td><td style=";">data</td></tr><tr ><td style="color: #161120;text-align: center;">12</td><td style=";">data</td><td style=";">data</td><td style=";">data</td><td style=";">data</td></tr><tr ><td style="color: #161120;text-align: center;">13</td><td style="text-align: right;;"></td><td style=";">subtotal</td><td style=";">subtotal</td><td style=";">subtotal</td></tr><tr ><td style="color: #161120;text-align: center;">14</td><td style=";">data</td><td style=";">data</td><td style=";">data</td><td style=";">data</td></tr><tr ><td style="color: #161120;text-align: center;">15</td><td style=";">data</td><td style=";">data</td><td style=";">data</td><td style=";">data</td></tr><tr ><td style="color: #161120;text-align: center;">16</td><td style=";">data</td><td style=";">data</td><td style=";">data</td><td style=";">data</td></tr><tr ><td style="color: #161120;text-align: center;">17</td><td style=";">data</td><td style=";">data</td><td style=";">data</td><td style=";">data</td></tr><tr ><td style="color: #161120;text-align: center;">18</td><td style=";">data</td><td style=";">data</td><td style=";">data</td><td style=";">data</td></tr><tr ><td style="color: #161120;text-align: center;">19</td><td style="text-align: right;;"></td><td style=";">subtotal</td><td style=";">subtotal</td><td style=";">subtotal</td></tr></tbody></table><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><thead><tr style="background-color: #E0E0F0;text-align: center;color: #161120"><th><b>Sheet1</b></th></tr></td></thead></table><br /><br />

If this isn't the case, would you be able to upload a screenshot of your data so I can better picture it?