PDA

View Full Version : Solved: Filldown formulas untill formula errors



Shazam
02-27-2008, 08:51 AM
Hi everyone,


I have a slow calculation problem when filling down formulas. Is there a code that will fill down the formulas and stop at the first formula error?



I left an example workbook below.

Bob Phillips
02-27-2008, 09:35 AM
Is this what you mean Shaz?

=IF(ISERROR(SMALL(IF($A$2:$A$30="1",Unique),ROWS(F$1:F1))),"",
INDEX($B$2:$B$30,MATCH(SMALL(IF($A$2:$A$30="1",Unique),ROWS(F$1:F1)),MMULT(($B$2:$B$30>TRANSPOSE($B$2:$B$30))+0,ROW($B$2:$B$30)^0),0)))

mdmackillop
02-27-2008, 09:39 AM
...

Dim i As Long, c As Range
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
With Cells(i, 6).Resize(, 3)
.FillDown
On Error Resume Next
Set c = .SpecialCells(xlCellTypeFormulas, 16)
If Not c Is Nothing Then
c.ClearContents
Exit Sub
End If
End With
Next
End Sub

Bob Phillips
02-27-2008, 09:41 AM
The other two would be

=IF(ISERROR(SMALL(IF($A$2:$A$30="1",IF($B$2:$B$30=F1,ROW($B$2:$B$30)-ROW($B$2)+1)),COUNTIF($F$1:F1,F1))),"",
INDEX($C$2:$C$30,SMALL(IF($A$2:$A$30="1",IF($B$2:$B$30=F1,ROW($B$2:$B$30)-ROW($B$2)+1)),COUNTIF($F$1:F1,F1))))

and

=IF(ISERROR(SMALL(IF($A$2:$A$30="1",IF($B$2:$B$30=F1,IF($C$2:$C$30=G1,ROW($B$2:$B$30)-ROW(C$2)+1))),SUM((F$1:F1=F1)*(G$1:G1=G1)))),"",
INDEX($D$2:$D$30,SMALL(IF($A$2:$A$30="1",IF($B$2:$B$30=F1,IF($C$2:$C$30=G1,ROW($B$2:$B$30)-ROW(C$2)+1))),SUM((F$1:F1=F1)*(G$1:G1=G1)))))

Shazam
02-27-2008, 09:48 AM
Hi xld,


No. The data you see there fluctuates daily I use a macro record to fill down the formulas BUT to be sure to capture all the results I have to fill down the formulas all the way down to row 150 and resulting a lot of #NUM! errors, to speed up the calculation time I would like a vba code to fill down the formula all the way down until it stops at the very first #NUM! error.

Let me know if I explain it correctly sometimes my words get confusing.

Shazam
02-27-2008, 09:51 AM
...

Dim i As Long, c As Range
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
With Cells(i, 6).Resize(, 3)
.FillDown
On Error Resume Next
Set c = .SpecialCells(xlCellTypeFormulas, 16)
If Not c Is Nothing Then
c.ClearContents
Exit Sub
End If
End With
Next
End Sub





Perfect mdmackillop thank so much!.

Thanks everyone for your help.

Bob Phillips
02-27-2008, 09:56 AM
Dim cell As Range
Dim LastRow As Long

LastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Range("F1").Resize(LastRow, 3)
.FillDown
On Error Resume Next
Set cell = .SpecialCells(xlCellTypeFormulas, 16)
If Not cell Is Nothing Then
cell.Offset(1, 0).Resize(LastRow - cell.Row - 1).ClearContents
End If
End With

mdmackillop
02-27-2008, 10:21 AM
Bob,
I thought of that, but Shaz said it was slow to fill.

Shaz,
Out of interest, is one quicker than the other?

Shazam
02-27-2008, 10:58 AM
Bob,
Shaz,
Out of interest, is one quicker than the other?


Hi mdmackillop,


Actually xld code is faster filling down but it did not clear all the errors so I took part of your code and insert into xld code and it works great.


Sub Test3()

Dim cell As Range
Dim LastRow As Long

LastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Range("F1").Resize(LastRow, 3)
.FillDown
On Error Resume Next
Set cell = .SpecialCells(xlCellTypeFormulas, 16)
If Not cell Is Nothing Then
cell.ClearContents
End If
End With

End Sub


Thanks for all your help.:beerchug:

Bob Phillips
02-27-2008, 12:34 PM
It only missed one didn't it, which can be rectified with



Dim cell As Range
Dim LastRow As Long

LastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Range("F1").Resize(LastRow, 3)
.FillDown
On Error Resume Next
Set cell = .SpecialCells(xlCellTypeFormulas, 16)
If Not cell Is Nothing Then
cell.Offset(1, 0).Resize(LastRow - cell.Row).ClearContents
End If
End With

mdmackillop
02-27-2008, 03:20 PM
:beerchug: Co-operation usually works best.