Below is code that copies a formula down a worksheet until it reached the end
of the dataset. The formula is a sumif with variables that move as the
formula is copied down.

It runs fine, but takes about 2 minutes to complete around 1000 rows of
data. I am thinking there has to be a better way to do this. Any
suggestions?

Dim u1 As Range
Dim u2 As Range
Dim iSum As Range
Dim cSum As Range
Dim i As Integer

Set u1 = Sheet2.Range("N11")
Set u2 = Sheet2.Range("N12")
Set iSum = Sheet2.Range("C12:G12")
Set cSum = Sheet2.Range("C11:G11")

i = 1

Do Until Application.WorksheetFunction.Sum(iSum) = 0

u2 = "=IF(SUM(" & iSum.Address(False, False) & ")=SUM(" &
cSum.Address(False, False) & ")," & u1.Address(False, False) & " ," &
u1.Address(False, False) & "+" & i & ")"

Set u1 = u1.Offset(1, 0)
Set u2 = u2.Offset(1, 0)
Set iSum = iSum.Offset(1, 0)
Set cSum = cSum.Offset(1, 0)

Loop

Running 2007 with XP SP2.

Thanks!
PJ

PJ
A couple of things will speed what you have up massively:

Application.screenupdating = false
Application.calculation = xlcalculationmanual

at the start and reversed at the end will have a big performance impact

I normally get the full range first (rather than looping through)
either using u1.end xldown or some other logic to find that last cell

Then set the formulas in one go:

Sheet2.range("N11").select 'needed so formulas are correctly relative

Sheet2.range(sheet2.range("N11"), _
sheet2.range("N11").end(xldown)).formula = _
"=IF(SUM(C11:G11)=SUM(C10:G10), N10, N10 + 1)"


Maybe this should all be moved down one looking at your code again

I'm sure that is slightly wrong somewhere but you should be able to make
it do what you want.

Cheers
Simon
Excel development website: www.codematic.net


PJFry wrote:
Below is code that copies a formula down a worksheet until it reached the end
of the dataset. The formula is a sumif with variables that move as the
formula is copied down.

It runs fine, but takes about 2 minutes to complete around 1000 rows of
data. I am thinking there has to be a better way to do this. Any
suggestions?

Dim u1 As Range
Dim u2 As Range
Dim iSum As Range
Dim cSum As Range
Dim i As Integer

Set u1 = Sheet2.Range("N11")
Set u2 = Sheet2.Range("N12")
Set iSum = Sheet2.Range("C12:G12")
Set cSum = Sheet2.Range("C11:G11")

i = 1

Do Until Application.WorksheetFunction.Sum(iSum) = 0

u2 = "=IF(SUM(" & iSum.Address(False, False) & ")=SUM(" &
cSum.Address(False, False) & ")," & u1.Address(False, False) & " ," &
u1.Address(False, False) & "+" & i & ")"

Set u1 = u1.Offset(1, 0)
Set u2 = u2.Offset(1, 0)
Set iSum = iSum.Offset(1, 0)
Set cSum = cSum.Offset(1, 0)

Loop

Running 2007 with XP SP2.

Thanks!
PJ

Wow, just the
Application.screenupdating = false
Application.calculation = xlcalculationmanual

took this from a 3 minute macro to a 10 second macro.

I am going to try applying the formula to a range next. That never occured
to me.

Thanks!
PJ


"Simon Murphy" wrote:

PJ
A couple of things will speed what you have up massively:

Application.screenupdating = false
Application.calculation = xlcalculationmanual

at the start and reversed at the end will have a big performance impact

I normally get the full range first (rather than looping through)
either using u1.end xldown or some other logic to find that last cell

Then set the formulas in one go:

Sheet2.range("N11").select 'needed so formulas are correctly relative

Sheet2.range(sheet2.range("N11"), _
sheet2.range("N11").end(xldown)).formula = _
"=IF(SUM(C11:G11)=SUM(C10:G10), N10, N10 + 1)"


Maybe this should all be moved down one looking at your code again

I'm sure that is slightly wrong somewhere but you should be able to make
it do what you want.

Cheers
Simon
Excel development website: www.codematic.net


PJFry wrote:
Below is code that copies a formula down a worksheet until it reached the end
of the dataset. The formula is a sumif with variables that move as the
formula is copied down.

It runs fine, but takes about 2 minutes to complete around 1000 rows of
data. I am thinking there has to be a better way to do this. Any
suggestions?

Dim u1 As Range
Dim u2 As Range
Dim iSum As Range
Dim cSum As Range
Dim i As Integer

Set u1 = Sheet2.Range("N11")
Set u2 = Sheet2.Range("N12")
Set iSum = Sheet2.Range("C12:G12")
Set cSum = Sheet2.Range("C11:G11")

i = 1

Do Until Application.WorksheetFunction.Sum(iSum) = 0

u2 = "=IF(SUM(" & iSum.Address(False, False) & ")=SUM(" &
cSum.Address(False, False) & ")," & u1.Address(False, False) & " ," &
u1.Address(False, False) & "+" & i & ")"

Set u1 = u1.Offset(1, 0)
Set u2 = u2.Offset(1, 0)
Set iSum = iSum.Offset(1, 0)
Set cSum = cSum.Offset(1, 0)

Loop

Running 2007 with XP SP2.

Thanks!
PJ