Solved: Filldown formulas untill formula errors

[Shazam]

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]

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]

[VBA]
...

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

[/VBA]

[Bob Phillips]

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]

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]

[vba]
...

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

[/vba]

Perfect mdmackillop thank so much!.

Thanks everyone for your help.

[Bob Phillips]

[vba]

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
[/vba]

[mdmackillop]

Bob,
I thought of that, but Shaz said it was slow to fill.

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

[Shazam]

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.

[vba]
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
[/vba]

Thanks for all your help.

[Bob Phillips]

It only missed one didn't it, which can be rectified with

[vba]

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
[/vba]

[mdmackillop]

Co-operation usually works best.