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/y4sdcfvijor1gh6spai3z/Linear-Interpolation.xlsm?dl=0&rlkey=raum6e723g9mahdpz0vg1x7xu

[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")


28951