Interpolate missing values

Public Sub interpolateTable()
  Dim rs As DAO.Recordset
  Dim startVal As Double
  Dim endVal As Double
  Dim updateVal As Double
  Dim startPos As Integer
  Dim endPos As Integer
  Dim interval As Double
  Dim criteria As String
  Dim bk As Variant
  
  criteria = "dblVal is not null"
  Set rs = CurrentDb.OpenRecordset("tblDates", dbOpenDynaset)
  If rs.EOF And rs.BOF Then
    Exit Sub
  Else
    rs.MoveFirst
  End If
  
  If Not IsNull(rs.Fields("dblVal")) Then
    startVal = rs.Fields("dblVal")
    rs.FindNext criteria
    endPos = rs.AbsolutePosition
    endVal = rs.Fields("dblVal")
  Else
    rs.FindNext criteria
    startVal = rs.Fields("dblVal") / (rs.AbsolutePosition + 1)
    endVal = rs.Fields("dblVal")
    endPos = rs.AbsolutePosition
    rs.MoveFirst
    rs.Edit
      rs.Fields("dblVal").Value = startVal
    rs.Update
    End
  End If
  'see if the first record has a value if not the
  'start pos
  
  'MsgBox "start" & startPos & "  val " & startVal & " end" & endPos & " val" & endVal
  
  interval = getInterval(startPos, endPos, startVal, endVal)
  'MsgBox interval
  rs.MoveFirst
  If Not IsNull(rs.Fields("dblVal")) Then
   rs.MoveNext
  End If
   updateVal = startVal
   Do While Not rs.EOF
   
    If IsNull(rs.Fields("dblVal")) Then
      updateVal = updateVal + interval
      rs.Edit
      rs.Fields("dblVal") = updateVal
      rs.Update
    Else
       updateVal = rs.Fields("dblVal")
       startPos = rs.AbsolutePosition
       startVal = rs.Fields("dblVal").Value
       bk = rs.Bookmark
      rs.FindNext criteria
      If rs.NoMatch Then
          endPos = rs.RecordCount
          endVal = endPos - startVal
       Else
         endPos = rs.AbsolutePosition
         endVal = rs.Fields("dblVal").Value
       End If
       interval = getInterval(startPos, endPos, startVal, endVal)
       rs.Bookmark = bk
    End If
    rs.MoveNext
  Loop
End Sub

Public Function getInterval(startPos As Integer, endPos As Integer, startVal As Double, endVal As Double)
  If Not Abs(endPos - startPos) < 0.000001 Then
    MsgBox (endPos - startPos)
    getInterval = (endVal - startVal) / ((endPos - startPos))
  End If
End Function

Public Function basInterpolateRs()

    Dim dbs As DAO.Database
    Dim rstDates As DAO.Recordset
    Dim rstSeedVals As DAO.Recordset

    Dim iDate As Date               'Inital Date for a sequence
    Dim eDate As Date               'End date for a sequence
    Dim iVal As Single              'Inital value for a sequence
    Dim eVal As Single              'End Value for a sequence
    Dim sglStep() As Single         'Interval / Step for a sequence
    Dim sglSeedVals() As Single     'Values seeded in the rs
    Dim dtSeedDates() As Date       'Values seeded in the rs
    Dim Idx As Integer

    'For Demo purposes, initalize the year _
     and seed some random dates with random values.  To run for production _
     Comment out the following call to basMakeYrDates
    Call basMakeYrDates

    Set dbs = CurrentDb

    'SQL for qry_valDates.  Of course change the table Name to suit.  The table used _
     here is strictly for Demo purposes.  In any production process the field names _
     also need to be associated with the actual table.  Here, the dtDate field is _
     Date type, while the valDate is a single.
    'strSQL = "SELECT dtDate, valDate " _
            & "FROM tblDateSeq " _
            & "WHERE (((valDate) <> 0)) Or " _
            & "(((dtDate) = DateSerial(Year(Date), 1, 1))) Or " _
            & "(((dtDate) = DateSerial(Year(Date), 12, 31))) " _
            & "ORDER BY dtDate;"

    'This is the ordered list of dates with values.  It FORCES the list to _
     include the first and last elements of the list (new years day to start _
     and New Years Eve to end.  Unless these HAPPEN to have values, they _
     will generally be 0 as the interval is assumed (here at least to be numeric).
    Set rstSeedVals = dbs.OpenRecordset("qry_ValDates", dbOpenDynaset)
    rstSeedVals.MoveLast
    rstSeedVals.MoveFirst
    DoEvents

    'Creates a set of local arrays for the dates which have values associated, _
     and the values asociated with the dates.
    Idx = rstSeedVals.RecordCount
    ReDim sglSeedVals(Idx)
    ReDim dtSeedDates(Idx)
    ReDim sglStep(Idx)

    'Get the seed values and their dates from the query
    Idx = 0
    While rstSeedVals.EOF = False
        sglSeedVals(Idx) = rstSeedVals!valDate
        dtSeedDates(Idx) = rstSeedVals!dtDate
        rstSeedVals.MoveNext
        Idx = Idx + 1
    Wend

    'Calculate step values for the intervals
    Idx = 0
    While Idx < UBound(sglSeedVals)
        iDate = dtSeedDates(Idx)
        eDate = dtSeedDates(Idx + 1)
        iVal = sglSeedVals(Idx)
        eVal = sglSeedVals(Idx + 1)

        sglStep(Idx) = (eVal - iVal) / (DateDiff("d", iDate, eDate))
        Idx = Idx + 1
    Wend

    'Show us the step values (not necessary - except to understand)
    Idx = 0
    While Idx < UBound(sglSeedVals)
        Debug.Print Idx, dtSeedDates(Idx), sglSeedVals(Idx), sglStep(Idx)
        Idx = Idx + 1
    Wend
    
    Set rstDates = dbs.OpenRecordset("tblDateSeq", dbOpenDynaset)

    'Using the local arrays, calculate (interpolate) and insert the missing values
    Idx = 0
    While Idx < UBound(sglSeedVals)

        While rstDates!dtDate < dtSeedDates(Idx + 1)
            iVal = iVal + sglStep(Idx)
            rstDates.Edit
                rstDates!valDate = iVal
            rstDates.Update
            rstDates.MoveNext
        Wend
        Idx = Idx + 1
    Wend

End Function
Public Function basMakeYrDates()

    'Just be able to male a list of the dates in a Calendar Year _
     and randomly fill about a Dozen with value fields with apparently _

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim sglRandVal(12) As Single    'Array of random values to insert, randomly
    Dim dtRandVal(12) As Double     'Array of random Dates for the values

    Dim dtStart As Date
    Dim dtCurr As Date
    Dim dtEnd As Date
    Dim intRange As Integer
    Dim intDays As Integer                      'Days in the Year [365 | 366]
    Dim Idx As Integer
    Dim strCriteria As String
    
    dtCurr = DateSerial(Year(Date), 1, 1)       '1/1/this year
    dtStart = dtCurr
    dtEnd = DateSerial(Year(Date), 12, 31)      '12/31/thisYear
    intDays = DateDiff("d", dtCurr, dtEnd)
    intRange = (dtEnd - dtCurr + 1)

    'Get the random values
    Randomize
    While Idx < UBound(sglRandVal)
        sglRandVal(Idx) = Rnd() * intDays
        dtRandVal(Idx) = CLng(intRange * Rnd())
        Idx = Idx + 1
    Wend

    DoCmd.SetWarnings False
        DoCmd.RunSQL "Delete * From tblDateSeq;"
    DoCmd.SetWarnings False

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("tblDateSeq", dbOpenDynaset)

    With rst
        While dtCurr <= dtEnd
            .AddNew
                !dtDate = dtCurr
            .Update
            dtCurr = DateAdd("d", 1, dtCurr)
        Wend
        DoEvents
    End With

    Idx = 0
    While Idx <= UBound(sglRandVal)
        strCriteria = "[dtDate] = " & Chr(35) & DateAdd("d", dtRandVal(Idx), dtStart) & Chr(35)
        rst.FindFirst strCriteria
        If (rst.NoMatch = False) Then
            rst.Edit
                rst!valDate = sglRandVal(Idx)
            rst.Update
         Else
            Stop
        End If
        Idx = Idx + 1
    Wend

End Function