Excel - find empty cells and linearize between data points

Question

Hello. 

I have the following question regarding linearization between data points.

First of all, the format is the following:

x-axis: power

y1 axis: leading

y2 axis: lagging

The tables were previously created by running a macro. The data points are fixed for a specific case (Table 1 = case 1, Table 2= case 2 etc.) BUT: The format for each table is not the same, i.e. the empty cells (no value) in column "leading" and "lagging" are not always on the same position. 

Question for macro:

1. find the cells with no value in column "leading" and "lagging" (= empty cells)
2. Fill in the "empty cells" by linearizing between data points above and below for column "lagging" and "leading" 

Many thanks for your help!

Best, Lucas

Answer 1

Here is a modified version:

Sub InterpolateAll()

    InterpolateBlanks "A", "B"

    InterpolateBlanks "A", "C"

    InterpolateBlanks "E", "F"

    InterpolateBlanks "E", "G"

End Sub

Sub InterpolateBlanks(b As String, c As String)

    ' The first argument is the power column

    ' The second argument is the leading or lagging column

    Dim FirstRow As Long

    Dim LastRow As Long

    Dim r As Long

    Dim r1 As Long

    Dim r2 As Long

    Dim b1 As Double

    Dim b2 As Double

    Dim v1 As Double

    Dim v2 As Double

    Dim f As Boolean

    Dim s As Long

    Application.ScreenUpdating = False

    FirstRow = 3

    Do While Cells(FirstRow, c).Value = ""

        FirstRow = FirstRow + 1

    Loop

    LastRow = Cells(Rows.Count, c).End(xlUp).Row

    r = FirstRow

    Do While r <= LastRow

        If Cells(r, c).Value <> "" Then

            If f Then

                r2 = r

                b2 = Cells(r, b).Value

                v2 = Cells(r, c).Value

                For s = r1 + 1 To r2 - 1

                    Cells(s, c).Value = v1 + (Cells(s, b).Value - b1) / (b2 - b1) * (v2 - v1)

                Next s

                f = False

            End If

            r1 = r

            b1 = Cells(r, b).Value

            v1 = Cells(r, c).Value

        Else

            f = True

        End If

        r = r + 1

    Loop

    Application.ScreenUpdating = True

End Sub

Answer 2

Here is some VBA code. Before running it:

1. Change the column letters in InterpolateAll. As it is now, columns B, C, F and G will be processed.
2. Change the number 3 in the line FirstRow = 3 to the row below the headers power, leading etc.

Sub InterpolateAll()

    InterpolateBlanks "B"

    InterpolateBlanks "C"

    InterpolateBlanks "F"

    InterpolateBlanks "G"

End Sub

Sub InterpolateBlanks(c As String)

    Dim FirstRow As Long

    Dim LastRow As Long

    Dim r As Long

    Dim r1 As Long

    Dim r2 As Long

    Dim v1 As Double

    Dim v2 As Double

    Dim f As Boolean

    Dim s As Long

    Application.ScreenUpdating = False

    FirstRow = 3

    Do While Cells(FirstRow, c).Value = ""

        FirstRow = FirstRow + 1

    Loop

    LastRow = Cells(Rows.Count, c).End(xlUp).Row

    r = FirstRow

    Do While r <= LastRow

        If Cells(r, c).Value <> "" Then

            If f Then

                r2 = r

                v2 = Cells(r, c).Value

                For s = r1 + 1 To r2 - 1

                    Cells(s, c).Value = v1 + (s - r1) / (r2 - r1) * (v2 - v1)

                Next s

                f = False

            End If

            r1 = r

            v1 = Cells(r, c).Value

        Else

            f = True

        End If

        r = r + 1

    Loop

    Application.ScreenUpdating = True

End Sub

Answer 3

I calculate different results and the curve or more "smoother" between the points.

Before you copy the code below into your file please read this article:
VBA issues with new forum editor - Microsoft Community

I assume your data is formatted as table, select a cell inside the table, then run the code.

Andreas.

Sub Test()

  Dim Data

  Dim i As Long, j As Long, k As Long

  Dim f As Long, t As Long

  Dim x, y

  With ActiveCell.ListObject.DataBodyRange

    Data = .Value

    For i = 1 To 2

      For j = 2 To 3

        Data(i, j) = 0

      Next

    Next

    For j = 2 To 3

      For i = 1 To UBound(Data)

        If IsEmpty(Data(i, j)) Then

          For f = i To 1 Step -1

            If Not IsEmpty(Data(f, j)) Then Exit For

          Next

          For t = i To UBound(Data)

            If Not IsEmpty(Data(t, j)) Then Exit For

          Next

          If t > UBound(Data) Then

            f = f - 1

            t = f + 1

          End If

          ReDim x(f To t)

          ReDim y(f To t)

          For k = f To t

            x(k) = Data(k, 1)

            y(k) = Data(k, j)

          Next

          Data(i, j) = WorksheetFunction.Forecast(Data(i, 1), y, x)

        End If

      Next

    Next

    .Value = Data

  End With

End Sub

Answer 4

Excel 365 with Power Query.

Extra/Inter/Polate more accurater.

No VBA.

https://www.mediafire.com/file/dsjz5q2e3hltg08/03_15_21.xlsx/file

https://www.mediafire.com/file/qd9ullapi52ivur/03_15_21.pdf/file

Answer 5

Many thanks, it works for one table with 3 columns. 

What about this setup, what do I need to change in the code?