More efficient code for a copy loop

lucky245

New Member
Joined
Jun 21, 2010
Messages
7
The below code works perfectly but when doing 20 odd thousand rows it takes a good bit of time so I was just seeing if there was a more efficient method of doing same thing.

Sub CopySensToReleventCell() '
Dim i As Long
Dim y As Integer
cgws.Select 'selecting results worksheet
For i = 2 To CalcRowscgr ' For statement from 2 to total number of rows in sheet
If Cells(i, 2) = "" Then 'column 9 should have a value but sometimes wont for various reasons
Cells(i, 2) = "NR" 'Put NR in where there was a blank because result maybe too weak
End If
For y = 3 To cgws.UsedRange.Columns.Count
' starts at col 3 and counts number of columns (currently 25) incase of additional column required
If Cells(i, 1) = Cells(1, y) Then 'if test code in column matched top row of same process
Cells(i, y) = Cells(i, 2) ' copy into cell under relevant result
Exit For ‘exits y for loop
End If
Next y
Next i
End Sub

Eg below

Start

Code
Result
AMI
AMO
AMP
CAX
CTP
CNO
DNo
AMI
S
AMP
s
CAX
R
DNo
NR

<tbody>
</tbody>

End result
Code
Result
AMI
AMO
AMP
CAX
CTP
CNO
DNo
AMI
S
S
AMP
s
s
CAX
R
R
DNo
NR
NR

<tbody>
</tbody>
 

Some videos you may like

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
55,882
Office Version
  1. 365
Platform
  1. Windows
Do you really need code to do this? This can be done pretty easily with an Excel formula.
Assuming that your data start in cell A1 with the title, so the first cell that you are filling in is C2, enter this formula in C2:
Code:
=IF($A2=C$1,$B2,"")
Then, copy this formula down in all the blank cells (down to I5).

The VBA to do that would look something like this:
Code:
Sub MyFillMacro()

    Dim lastCol As Long
    Dim lastRow As Long
    
'   Find last column in row 1
    lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
'   Find last row in column A
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Populate all cells starting from C2 going to the end
    Range(Cells(2, 3), Cells(lastRow, lastCol)).FormulaR1C1 = "=IF(RC1=R1C,RC2,"""")"

End Sub
If you want to replace all those formulas with just the hard-coded values, then just add this one row to the end of the code above:
Code:
    Range(Cells(2, 3), Cells(lastRow, lastCol)).Value = Range(Cells(2, 3), Cells(lastRow, lastCol)).Value
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,122,187
Messages
5,594,753
Members
413,930
Latest member
Nela817

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
Top