Any way to speed up this loop? Copying data only

A

attikuz

New Member
Joined
Jul 23, 2013
Messages
26
Office Version
  1. 365
Hi there,

I've created some code which formats data into a table that can be used for a Pivot Table. However, there are c. 20,000 rows for the loop to go through and so far it has taken 50 mins to run and only completed 1,000 rows, and still hasn't finished. I was wondering if anyone would mind taking a look to see if there are any ways of speeding it up. Thanks!

VBA Code: 
Option Explicit

Sub SortHoldingData()
'This macro sorts all the holding data by security, asset class and portfolio

Application.ScreenUpdating = False
'First we clear the existing data
Sheets("Full Holding Data (2)").Select
Dim i As Integer
i = Cells(Rows.Count, 4).End(xlUp).Row
Range("A2:O" & i).Clear

'Next we move to the raw data exported from RID and define how many rows we are going to loop through
Sheets("Raw Holding Data").Select
Dim NumRows As Integer
Dim x As Integer
NumRows = Cells(Rows.Count, 2).End(xlUp).Row

'Here we are creating a loop to check if the row contains an ASSET CLASS, a SECURITY or a FUND REF. Depending on what comes up the data will be sorted and pasted into the appropriate column on the Full Holding Data tab
For x = 2 To NumRows

'This is checking to see if Column A is blank. If it is then the data in this row MUST be an asset class as it has no SEDOL or Fund Ref.
If Cells(x, 1) = "" Then
Range("B" & x).Copy
Sheets("Full Holding Data (2)").Select
Range("F" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Raw Holding Data").Select

'We want to store the sector data.
Dim Sector As String
Sector = Range("B" & x).Value

'If the above is not true then the data in the row must be a security or a fund ref. Here we are checking to see if it a security by checking if there is anything in the rating column.
ElseIf Cells(x, 3) <> "" Then Range("B" & x).Copy
Sheets("Full Holding Data (2)").Range("D" & x).PasteSpecial Paste:=xlPasteValues
Sheets("Raw Holding Data").Select
Range("A" & x).Copy
Sheets("Full Holding Data (2)").Range("A" & x).PasteSpecial Paste:=xlPasteValues
Sheets("Raw Holding Data").Select

'We also want to store the security name.
Dim secName As String
secName = Range("B" & x).Value

'Finally if the above two statements are false then it must be a fund ref, so now we copy down.
Else: Range("A" & x).Copy
Sheets("Full Holding Data (2)").Range("B" & x).PasteSpecial Paste:=xlPasteValues
Sheets("Raw Holding Data").Range("B" & x).Copy
Sheets("Full Holding Data (2)").Range("C" & x).PasteSpecial Paste:=xlPasteValues
Sheets("Raw Holding Data").Range("G" & x).Copy
Sheets("Full Holding Data (2)").Range("K" & x).PasteSpecial Paste:=xlPasteValues
Sheets("Full Holding Data (2)").Range("D" & x).Value = secName
Sheets("Full Holding Data (2)").Range("F" & x).Value = Sector
End If

Next x

Application.ScreenUpdating = True
End Sub
 
Last edited by a moderator:

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Sort by date Sort by votes
How about
VBA Code: 
Sub attikuz()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long
   Dim Sector As String, secName As String
   
   With Sheets("Full Holding Data (2)")
      Range("A2:O" & .Range("D" & Rows.Count).End(xlUp).Row).Clear
   End With
   With Sheets("Raw Holding Data")
      Ary = .Range("A2:G" & .Range("B" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 11)
   
   For r = 1 To UBound(Ary)
      If Ary(r, 1) = "" Then
         Nary(r, 6) = Ary(r, 2)
         Sector = Ary(r, 2)
      ElseIf Ary(r, 3) <> "" Then
         Nary(r, 4) = Ary(r, 2)
         Nary(r, 1) = Ary(r, 1)
         secName = Ary(r, 2)
      Else
         Nary(r, 2) = Ary(r, 1)
         Nary(r, 3) = Ary(r, 2)
         Nary(r, 11) = Ary(r, 7)
         Nary(r, 4) = secName
         Nary(r, 6) = Sector
      End If
   Next r
   Sheets("Full Holding Data (2)").Range("A2").Resize(r - 1, 11).Value = Nary
End Sub
 
Upvote 0
Fluff said:
How about
VBA Code: 
Sub attikuz()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long
   Dim Sector As String, secName As String
  
   With Sheets("Full Holding Data (2)")
      Range("A2:O" & .Range("D" & Rows.Count).End(xlUp).Row).Clear
   End With
   With Sheets("Raw Holding Data")
      Ary = .Range("A2:G" & .Range("B" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 11)
  
   For r = 1 To UBound(Ary)
      If Ary(r, 1) = "" Then
         Nary(r, 6) = Ary(r, 2)
         Sector = Ary(r, 2)
      ElseIf Ary(r, 3) <> "" Then
         Nary(r, 4) = Ary(r, 2)
         Nary(r, 1) = Ary(r, 1)
         secName = Ary(r, 2)
      Else
         Nary(r, 2) = Ary(r, 1)
         Nary(r, 3) = Ary(r, 2)
         Nary(r, 11) = Ary(r, 7)
         Nary(r, 4) = secName
         Nary(r, 6) = Sector
      End If
   Next r
   Sheets("Full Holding Data (2)").Range("A2").Resize(r - 1, 11).Value = Nary
End Sub
Click to expand...

This just cleared all the data in both my Raw Holding Data and Full Holding Data sheets!
 
Upvote 0
Fluff said:
How about
VBA Code: 
Sub attikuz()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long
   Dim Sector As String, secName As String
  
   With Sheets("Full Holding Data (2)")
      Range("A2:O" & .Range("D" & Rows.Count).End(xlUp).Row).Clear
   End With
   With Sheets("Raw Holding Data")
      Ary = .Range("A2:G" & .Range("B" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 11)
  
   For r = 1 To UBound(Ary)
      If Ary(r, 1) = "" Then
         Nary(r, 6) = Ary(r, 2)
         Sector = Ary(r, 2)
      ElseIf Ary(r, 3) <> "" Then
         Nary(r, 4) = Ary(r, 2)
         Nary(r, 1) = Ary(r, 1)
         secName = Ary(r, 2)
      Else
         Nary(r, 2) = Ary(r, 1)
         Nary(r, 3) = Ary(r, 2)
         Nary(r, 11) = Ary(r, 7)
         Nary(r, 4) = secName
         Nary(r, 6) = Sector
      End If
   Next r
   Sheets("Full Holding Data (2)").Range("A2").Resize(r - 1, 11).Value = Nary
End Sub
Click to expand...

Oh i have to be in the Full Holding Data tab to run it and it works! It only took 2 seconds. I don't understand how it is so much faster!?
 
Upvote 0
attikuz said:
This just cleared all the data in both my Raw Holding Data and Full Holding Data sheets!
Click to expand...
Oops, I missed a full stop, it should be
VBA Code: 
  With Sheets("Full Holding Data (2)")
      .Range("A2:O" & .Range("D" & Rows.Count).End(xlUp).Row).Clear
   End With
Selecting cells & sheets slows down the code as the macro has to wait for the selection to take place.
Also continually reading & writing to/from cells can be slow.
The code I supplied pulls the data into an array & then does everything in memory until the end, where it writes the entire set of data to the sheet in one go.
 
Upvote 0
Fluff, thanks very much for your help!! I have one more question if that's alright...

As i get to the end of the rows, my last asset class is CASH and everything beneath that is formatted slightly different. So basically, once i get to cash I just want to stop the array. All the data is in columns B and G, and this needs to be pasted to C and K in my Full Holding Data sheet with "CASH" pasted in columns D and F.

Is there a way to stop the array when it finds cash? Or would i change my last column to cash and then add some new code under?

Thanks!

EDIT: Grammar..
 
Upvote 0
Which column does the word Cash appear in?
 
Upvote 0
Ok, how about
VBA Code: 
Sub attikuz()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long
   Dim Sector As String, secName As String
   
   With Sheets("Full Holding Data (2)")
      .Range("A2:O" & .Range("D" & Rows.Count).End(xlUp).Row).Clear
   End With
   With Sheets("Raw Holding Data")
      Ary = .Range("A2:G" & .Range("B" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 11)
   
   For r = 1 To UBound(Ary)
      If UCase(Ary(r, 2)) = "CASH" Then Exit For
      If Ary(r, 1) = "" Then
         Nary(r, 6) = Ary(r, 2)
         Sector = Ary(r, 2)
      ElseIf Ary(r, 3) <> "" Then
         Nary(r, 4) = Ary(r, 2)
         Nary(r, 1) = Ary(r, 1)
         secName = Ary(r, 2)
      Else
         Nary(r, 2) = Ary(r, 1)
         Nary(r, 3) = Ary(r, 2)
         Nary(r, 11) = Ary(r, 7)
         Nary(r, 4) = secName
         Nary(r, 6) = Sector
      End If
   Next r
   Sheets("Full Holding Data (2)").Range("A2").Resize(r - 1, 11).Value = Nary
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question
VBA optimization advice
Replies
3
Views
95
bobsan42
bobsan42
The Ruff Report
  • Solved
VBA - replace a character in a range to save
Replies
5
Views
178
RobP
R
H
  • Question
VBA Speed up Copy and paste
Replies
3
Views
370
skillilea
S
B
  • Solved
VBA is there a way to speed up?
Replies
4
Views
210
RoryA
RoryA
D
  • Solved
Parsing a spreadsheet
Replies
9
Views
263
NdNoviceHlp
NdNoviceHlp

Forum statistics

Threads
1,214,924
Messages
6,122,294
Members
449,077
Latest member
Rkmenon

Share this page

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