Can somebody speed this VBA up?

bigmacneb

Board Regular
Joined
Jul 12, 2005
Messages
93
I have 1300 lines of code, it goes relatively quick, but this part seems to slow it down dramatically. I'll paste the code, but notice it does not include columns W and X. Any thoughts?

Range("K3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("K3").Select
Selection.Copy
Range("K5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("K" & i).FormulaR1C1 = Range("K3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("L3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("L3").Select
Selection.Copy
Range("L5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("L" & i).FormulaR1C1 = Range("L3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("M3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("M3").Select
Selection.Copy
Range("M5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("M" & i).FormulaR1C1 = Range("M3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("N3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("N3").Select
Selection.Copy
Range("N5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("N" & i).FormulaR1C1 = Range("N3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("O3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("O3").Select
Selection.Copy
Range("O5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("O" & i).FormulaR1C1 = Range("O3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("P3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("P3").Select
Selection.Copy
Range("P5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("P" & i).FormulaR1C1 = Range("P3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("Q3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("Q3").Select
Selection.Copy
Range("Q5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("Q" & i).FormulaR1C1 = Range("Q3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("R3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("R3").Select
Selection.Copy
Range("R5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("R" & i).FormulaR1C1 = Range("R3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("S3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("S3").Select
Selection.Copy
Range("S5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("S" & i).FormulaR1C1 = Range("S3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("T3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("T3").Select
Selection.Copy
Range("T5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("T" & i).FormulaR1C1 = Range("T3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("U3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("U3").Select
Selection.Copy
Range("U5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("U" & i).FormulaR1C1 = Range("U3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("V3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("V3").Select
Selection.Copy
Range("V5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("V" & i).FormulaR1C1 = Range("V3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("Y3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("Y3").Select
Selection.Copy
Range("Y5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("Y" & i).FormulaR1C1 = Range("Y3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("Z3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("Z3").Select
Selection.Copy
Range("Z5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("Z" & i).FormulaR1C1 = Range("Z3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("AA3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("AA3").Select
Selection.Copy
Range("AA5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("AA" & i).FormulaR1C1 = Range("AA3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("AB3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("AB3").Select
Selection.Copy
Range("AB5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("AB" & i).FormulaR1C1 = Range("AB3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("AC3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("AC3").Select
Selection.Copy
Range("AC5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("AC" & i).FormulaR1C1 = Range("AC3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("AD3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("AD3").Select
Selection.Copy
Range("AD5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("AD" & i).FormulaR1C1 = Range("AD3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("AE3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("AE3").Select
Selection.Copy
Range("AE5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("AE" & i).FormulaR1C1 = Range("AE3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("AF3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("AF3").Select
Selection.Copy
Range("AF5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("AF" & i).FormulaR1C1 = Range("AF3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("AF3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("AF3").Select
Selection.Copy
Range("AF5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("AF" & i).FormulaR1C1 = Range("AF3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("AG3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("AG3").Select
Selection.Copy
Range("AG5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("AG" & i).FormulaR1C1 = Range("AG3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("AH3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("AH3").Select
Selection.Copy
Range("AH5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("AH" & i).FormulaR1C1 = Range("AH3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("AI3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("AI3").Select
Selection.Copy
Range("AI5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("AI" & i).FormulaR1C1 = Range("AI3").FormulaR1C1
Next i

Application.ScreenUpdating = True
'
Range("AJ3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("AJ3").Select
Selection.Copy
Range("AJ5").Select
ActiveSheet.Paste
Application.ScreenUpdating = False

For i = 5 To 499 Step 2
Range("AJ" & i).FormulaR1C1 = Range("AJ3").FormulaR1C1
Next i

Application.ScreenUpdating = True
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Is it that you want, in the 3rd row, to enter the formula ( using column K as an example)

=K2

and then for every odd row down to 499 have that formula be =K2 as well?

And you wish to do this for which columns?
 
Upvote 0
My goal is that I have info in even numbered rows down to 499. I need the formula =R[-1]C so that every odd numbered row reflects the data in the even numbered row above it.
 
Upvote 0
First thought, why so many lines of code?

This
Code:
Range("K3").Select 
ActiveCell.FormulaR1C1 = "=R[-1]C" 
Range("K3").Select 
Selection.Copy 
Range("K5").Select 
ActiveSheet.Paste 
Application.ScreenUpdating = False
could be replaced with this.
Code:
Range("K3").FormulaR1C1 = "=R[-1]C" 
Range("K3").Copy Range("K5")

Hope that might point you in the right direction, but I must leave now, the pub beckons.
 
Upvote 0
For starters, I'd stop selecting:
Code:
Range("K3").Select 
ActiveCell.FormulaR1C1 = "=R[-1]C" 
Range("K3").Select 
Selection.Copy 
Range("K5").Select 
ActiveSheet.Paste 
Application.ScreenUpdating = False
Can be:
Code:
With Range("K3")
   .FormulaR1C1 = "=R[-1]C" 
   .Copy  Range("K5")
End With
Also, you only need to set ScreenUpdating = False once, at the beginning of the code and set it to True at the end. Continuously setting/resetting it is a pretty big waste.

Hope that helps,

Smitty
 
Upvote 0
bigmacneb said:
My goal is that I have info in even numbered rows down to 499. I need the formula =R[-1]C so that every odd numbered row reflects the data in the even numbered row above it.

If the odd numbered rows in the relevant columns are all blank, and the even numbered rows contain no blanks, it could be done with one line of code :-

Code:
[K3:V499,Y3:AJ499].SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"

If the previously mentiond criteria do not apply, it could be done by identifying the odd row cells via a helper column, and then entering the formula with one line of code. For example, using column A as the helper column :-

Code:
Dim rng As Range
[A3:A499].FormulaR1C1 = "=IF(MOD(ROW(),2)=1,1,"""")"
Set rng = [A3:A499].SpecialCells(xlCellTypeFormulas, 1)
Intersect(rng.EntireRow, [K3:V499,Y3:AJ499]).FormulaR1C1 = "=R[-1]C"
[A3:A499].ClearContents
 
Upvote 0

Forum statistics

Threads
1,214,897
Messages
6,122,148
Members
449,066
Latest member
Andyg666

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