I need to Loop an a formula with the Offset function until the cell is blank

Question

I need to Loop the formula below until Column "B" which contains dates is empty. I am stuck and I just can't seem to write the VBA Code to do the Loop until there is no more Dates in Column "B". The formula is smoothing out the yields by using those dates that have a yield.

I hope anyone would be able to help me. Thanks in advance

      A      B       C         D
5   Factor Date    Yield     Input
6    3     May-10   .25 
7    1     Jun-10  
8    2     Jul-10  
9    3     Aug-10   0.2000 
10   1     Sep-10  
11   2     Oct-10  
12   3     Nov-10   0.2418 
13   1     Dec-10  
14   2     Jan-11  
15   3     Feb-11   0.3156 
16   1     Mar-11  
17   2     Apr-11  

.

Sub IsNumeric()


  //IF(ISNUMBER(C6),C6,

  If Application.IsNumber(range("c6").Value) Then

    range("d6").Value = range("c6")


    //IF(C6<C5,((OFFSET(C6,2,0)-OFFSET(C6,-1,0))*A6/3+OFFSET(C6,-1,0)),

    If range("c6").Select < range("c5").Select Then

      range("d6").Value = range("c6").Offset(2, 0).Select - range("c6").Offset(-1, 0).Select * (range("a6").Select / 3) + range("c6").Offset(-1, 0).Select


      //IF(C6<>C7,((OFFSET(C6,1,0)-OFFSET(C6,-2,0))*(A6/3)+OFFSET(C6,-2,0)),"")))

      If range("c6").Select <> range("c7").Select Then

        range("d6").Value = (range("c6").Offset(1, 0).Select) - range("c6").Offset(-2, 0).Select * (range("a6").Select / 3) + range("c6").Offset(-2, 0).Select

      Else
        range("d6").Value = ""

      End If
    End If
  End If

End Sub

Answer 1

Sub Test01()
 Dim m, r, cell As Object
 Dim n As Boolean

 Set m = Sheets("Sheet1").Cells(1, 2)
 Do
  Set m = m.Offset(1, 0)
  Set r = m.Resize(20, 1)
  n = False
  For Each cell In r
   If cell.Formula <> "" Then
    n = True
   End If
  Next cell

  MsgBox m.Formula
 Loop Until n = False
End Sub

This will start at B1 and loop all the way down Column B until the loop encounters a cell at which, beneath it, are 20 contiguous blank cells. When the loop arrives at that cell that has 20 consecutive blanks cells beneath it, it will just Offset to the first of those blank cells beneath it and stop.

Answer 2

No. this not what i am looking for.

Answer 3

If I understand it correctly...

1. You'll need to convert hard coded ranges to variables
2. You are using offset correctly
3. I know while/wend is outdated, sorry :)

Sub IsNumeric()

dim tc as range

set tc = range("B6") 'this is always column B, but the row keeps changing in the loop

//IF(ISNUMBER(C6),C6,

while tc <> "" If Application.IsNumber(tc.offset(0,1).Value) Then

tc.offset(0,2).Value = tc.offset(0,1)


//IF(C6<C5,((OFFSET(C6,2,0)-OFFSET(C6,-1,0))*A6/3+OFFSET(C6,-1,0)),

If tc.offset(0,1) < tc.offset(-1,1) Then

  tc.offset(0,2).Value = tc.Offset(2, 1) - tc.Offset(-1, 1) * (tc.offset(0,-1) / 3) + tc.Offset(-1, 1)


  //IF(C6<>C7,((OFFSET(C6,1,0)-OFFSET(C6,-2,0))*(A6/3)+OFFSET(C6,-2,0)),"")))

  If tc.offset(0,1) <> tc.offset(1,1) Then

    tc.offset(0,2) = tc.offset(1,1) - tc.offset(-2,1) * (tc.offset(0,-1) / 3) + tc.offset(-2,1)

  Else
    tc.offset(0,2) = ""

  End If
End If

End If

set tc=tc.offset(1,0)

wend End Sub