Linear Interpolation

[enjam]

Hi all,

I have a column of data with a set of known values that are populated in descending order. Between these known values are several blank cells. The number of blank cells between known values varies considerably.

I'm trying to develop a macro that will populate the intermediate values between the known values (just through linear interpolation) into those blank cells.

E.g.

If I have '1, blank cell, blank cell, blank cell, 2, blank cell, blank cell, 6'

Then the macro should produce:

'1, 1.25, 1.50, 1.75, 2, 3.33, 4.67, 6'

Attached is an example of the dataset I have (Column A), and what I'm trying to achieve (Column B).

Any help would be greatly appreciated

[arnelgp]

please see this workbook and run the function.
sorry my browser does not allow me to attached to this site.
https://www.dropbox.com/scl/fi/y4sdc...mahdpz0vg1x7xu

[Paul_Hossler]

Try this

Option Explicit


Sub LinInterp()
    Dim rKnown As Range, rGap As Range
    Dim dLow As Double, dHigh As Double, dIncr As Double
    Dim cntGapCells As Long, iArea As Long, iGap As Long
    
    Set rKnown = ActiveSheet.Columns(1).SpecialCells(xlCellTypeConstants, xlNumbers)


    With rKnown
        For iArea = 1 To .Areas.Count
            .Areas(iArea).Cells(1, 2).Value = .Areas(iArea).Cells(1, 1).Value
        Next iArea
        
        
        For iArea = 1 To .Areas.Count - 1
            cntGapCells = .Areas(iArea + 1).Cells(1, 1).Row - .Areas(iArea).Cells(1, 1).Row - 1
            dLow = .Areas(iArea).Cells(1, 1).Value
            dHigh = .Areas(iArea + 1).Cells(1, 1).Value
            dIncr = (dHigh - dLow) / cntGapCells
        
            For iGap = .Areas(iArea).Cells(1, 1).Row + 1 To .Areas(iArea + 1).Cells(1, 1).Row - 1
                ActiveSheet.Cells(iGap, 2).Value = ActiveSheet.Cells(iGap - 1, 2).Value + dIncr
            Next iGap
        Next iArea
        
    End With
End Sub

[p45cal]

Try:

Sub blah()
For Each are In Columns("A:A").SpecialCells(xlCellTypeBlanks).Areas
  are.Resize(are.Rows.Count + 2).Offset(-1).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Trend:=True
Next are
End Sub

[enjam]

Thanks very much arnelgp, Paul_Hossler and p45scal for your replies

arnelgp, that's brilliant, works exactly as intended! And same with your code also p45cal, just needed to add 'Dim are as Range' at the start to get it working - impressed by how you got it to work with just a couple of lines.

Paul, that code works well, except it generates the same value as the known value for the previously-blank cell immediately above the known value.

[Paul_Hossler]

Glad one of the suggestions works for you. That's the important thing

I went back to learn where I went astray


I was off by a "- 1" counting gapCells

            cntGapCells = .Areas(iArea + 1).Cells(1, 1).Row - .Areas(iArea).Cells(1, 1).Row (no "-1")

Capture.JPG