Const TOLERANCE = 0.1
Const TOLERANCE2 = 0.5
Sub CustomCurve()
    Dim adder As Double
    Dim i As Integer
    Dim newValue As Double
    Range("B28:B32").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False
    [b28].Select
    For i = 2001 To 2005
        adder = 1
        While Abs([d28].Offset((i - 2001), 0)) > TOLERANCE
            If Abs([d28].Offset((i - 2001), 0)) / [d28].Offset((i - 2001), 0) 
= _
                    Abs(adder) / adder Then adder = adder / -10
            newValue = [b28].Offset((i - 2001), 0) + adder
            [b28].Offset((i - 2001), 0) = newValue
        Wend
    Next i
End Sub
Sub FlatLine()
    Dim adder As Double
    Dim i As Integer
    Dim newValue As Double
    Range("b28").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False
    For i = 2002 To 2005
        [b29].Offset((i - 2002), 0) = "=$B$28"
    Next i
    adder = 1
    While Abs([d33]) > TOLERANCE2
        If Abs([d33]) / [d33] = Abs(adder) / adder Then adder = adder / -10
        newValue = [b28] + adder
        [b28] = newValue
    Wend
End Sub