Shape Array TopLeftCell.Address

[ldarley]

Hi

I working with a series of shapes on a worksheet where I am holding the shape data in a array and then writing each shapes TopLeftCell.Address into another worksheet to do some calculations. The problem is the For loop is slow due to the number of iterations it has to go through.

The relevant part of the code looks like this:

'set up shape array

ReDim shape_index(1 To x)
For i = 1 To x
    shape_index(i) = i
Next


Set shprng = Sheet2.Shapes.Range(shape_index)

'write shape address to Sheet1

For i = 1 To x
     y = i + 1
     Sheet1.Cells(y, 5) = shprng(i).TopLeftCell.Address
Next

Is there a quick way or me to take all the TopLeftCell.Address data for each shape in the array and place that information into the other worksheet in one go or to I have to iterate through each shape and do that individually?

Any thoughts is greatly appreciated!

 

[jasonb75]

I suspect that this method might be slower, but might be worth comparing.

For i = 1 To x
     Sheet1.Cells(x + 1, 5) = Sheet2.Shapes(i).TopLeftCell.Address
Next

Are you using Screeupdating = False, Calculation = xlManual, etc. with your code? They can make a difference.

 

[ldarley]

thanks Jason yes I have everything disabled page breaks the lot,i'll give your suggestion a try.

This is a small section of my code without this section it runs in a couple of seconds, however with it, for around 300 shapes its takes about a minute and a half, which feels like an age.