Fill data series or resize range not working on large blank ranges

Hi Gareth

Welcome to the Forum...

Try this ...Output col L

Option Explicit
Option Compare Text
Sub sintekJ3v16()
Dim Data, Valu As Double, i As Long, rw As Long, x As Long
rw = 2
With Cells(1).CurrentRegion
    Data = .Value
    For i = 2 To UBound(Data)
        If Data(i, 4) = "s" Then
            Range("L" & i) = Data(i, 2)
            If i > 2 Then
                x = Application.CountBlank(Range("L2:L" & i)) + 1
                Valu = (1 / x) * -1
                Range("L" & rw).Resize(x).DataSeries , , , Valu, Data(i, 2)
                rw = i
            End If
        End If
    Next i
End With
End Sub