Linear interpolation using VBA for empty cells in a row

[LauraF]

Hello,

I would like to know if somebody can help me to build a macro on the attached file .
I created an excel function (rows PupilLeft_interpolation and PupilRight_interpolation) to calculate linear interpolation in order to estimate the missing data (empty cells in the rows PupilLeft and PupilRight), taking into account the known values. The function works but the problem is that when I wanted to copy to the rest of the cells, the file becomes very “heavy” (I normally have 130000 cells to copy the function). I’m really new with this so I would need some help to build the code using VBA.
I’d really appreciate if someone could help me!
Thanks in advance,Pupillo_Model_.xlsx

[MINCUS1308]

Thats one heck of a formula you've written out there.
Lets walk through this file so I understand whats happening.

you have the name and the date and a time stamp.
you break the time stamp down into the components

and then the important parts...
studioevent & studioeventdata ?? i don't actually know what those are for
missing left & right columns are a Boolean check that identify missing pupilleft/right data?

what exactly are the pupilleft & right interpolation columns doing?
if the name isnt blank and
if the pupilleft/right isnt a number
then
a really long formula looksup/matches/indexes its way to the answer?

i see that this data spans the gap of about 2 seconds and produced 420 ish lines of data.
perhaps a macro that stepped through each line and preformed the calculations would "lighten" your file.

if you can walk me through what needs to happen and not how you are calculating it I can try to assist you with a macro.

[MINCUS1308]

If I'm correct this basically boils down to

(A+B)*(C-D)]/(E-F) 

RP - RightPupil
T - Time (ms)

(RP+(T-T))  *  (RP-RP)]  /  (T-T) 

[MINCUS1308]

equation.png
Above is the equation for linear interpolation.
and you want to apply this equation when data is missing for P2?

[LauraF]

Hi MINCUS1308!

Thank you very much for your reply.

Yes, the file correspond to the continuous recording of pupil diameter (of the left eye and the right eye) during a given task. There is a stamp every 3 milliseconds. What I would like to do it is to estimate the values of the empty cells of the rows PupilLeft and PupilRight using the linear interpolation method. You completely understood what I want to do! I know that it should be an easier way to do this than the one that I used but I certainly need your help!!
Thank you!!!

[p45cal]

In the attached version of your file is a macro. That macro can be run by clicking the button in the sheet (it's in the vicinity of cell P152).
What this macro does is to copy wholesale columns J:K to columns S:T (because this is proof of concept, I wanted to leave your calculations in place in columns N:O as a cross check and to this end you'll see some simple formulae showing the difference between your calculations and mine in columns V:W from row 165 downwards).

Having copied the columns across, the intent was to take each column in turn and look for contiguous blank cells, once found, a check is made that there is a numeric value both in the cell directly above the blank cells and in the cell directly below them. If this is the case then a formula (actually an array formula) is put into the blank cells. The result of this formula is very, very slightly different from yours; that could be due to the internal workings/calculations of Excel or due to the fact that I've directly used the timestamp in column C (it may be that now you don't need columns D,E,F and G?).

In the code of the macro itself I have several lines that could be executed but that I've commented-out with a leading apostrophe. You can re-instate these lines if you want. Most of them are there to select cells so that one can see what's going on if one steps through the macro by repeatedly pressing F8 when the code window is the active window.
There are other lines which are only comments to indicate where we're at in the code.

One gotcha I did come across was that many of the cells in your sheet that appear blank, aren't treated as blank by Excel. Normally, on the sheet, you can select a range of cell, then press F5, choose Special… then choose Blanks, but it doesn't do what you might expect, so quite a bit of the code is just a workaround for this.

These formulae should be a lot 'lighter' for your sheet, however, it can be made even lighter by converting the results of the formula to plain values. There is a line towards the end of the macro, currently commented out, which you can make work, which does this. The line is:
'are.Value = are.Value 'uncomment this line by removing the leftmost apostrophe to remove the formulae and leave just values in the cells.

The macro can be run repeatedly without problems.
You can highlight where the formulae are in columns S:T by selecting them, pressng F5, choosing Special…, then choosing Formulas.
To delete the contents of columns S:T you should select them and press the delete key on the keyboard; this will delete the contents and formulae without deleting the columns themselves.

Now if this is satisfactory, it's a case of tweaking the macro to put the values where you want them and deleting the cross checking formulae.

Something else, I've put a comment in cell G3 which suggests a formula for that cell which uses only column C to give the result (but you may no longer need those values anyway).

[LauraF]

Wow p45cal!!!!! It works perfectly!!!! I have no enough words to thank you!!!! You've really HELPED me!!!!Thanks a lot!

Regards,
LauraF.

[snb]

or

Sub M_snb()
   For Each ar In Columns(10).SpecialCells(4).Areas
     x = ar.Cells(1).Offset(-1)
     y = ar.Cells(ar.Cells.Count).Offset(1)
     If x <> "" And y <> "" Then
        Z = (y - x) / (ar.Cells.Count + 1)
        For j = 1 To ar.Cells.Count
           ar.Cells(j) = format(x + j * Z,"0.00")
        Next
     End If
   Next
End Sub

[MINCUS1308]

p45cal thats exactly what i was going to say!
looks like they got you sorted out alot better than I could have done.

Good luck with your pupil study

[Paul_Hossler]

If you can take one more approach

There are a lot of 'helper' columns that are not really needed, and take time to calculate. These intermediate values can be generated by VBA

Option Explicit


Const cDateCol As Long = 2
Const cTimeCol As Long = 3
Const cPupilLeftCol As Long = 6
Const cPupilRightCol As Long = 7
Const cInterpLeftCol As Long = 8
Const cInterpRightCol As Long = 9


Sub Demo1()
    Dim ws As Worksheet
    Dim iLastRow As Long, iRow As Long, iStartRow As Long
    Dim rUp As Range, rDown As Range, rLeftPupil As Range, rRightPupil As Range, rCurrent As Range
    Dim dUp As Double, dDown As Double, dCurrent As Double

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set ws = ActiveSheet

    'find last row
    iLastRow = ws.Cells(ActiveSheet.Rows.Count, cTimeCol).End(xlUp).Row
    
   
    'clear 0 len strings
    For iRow = 2 To iLastRow
        If Len(ws.Cells(iRow, cPupilLeftCol).Value) = 0 Then ws.Cells(iRow, cPupilLeftCol).ClearContents
        If Len(ws.Cells(iRow, cPupilRightCol).Value) = 0 Then ws.Cells(iRow, cPupilRightCol).ClearContents
    Next iRow
    
    
    
    'fill in the knowns
    For iRow = 2 To iLastRow
        'if we got it, use it
        If ws.Cells(iRow, cPupilLeftCol).Value > 0# Then
            ws.Cells(iRow, cInterpLeftCol).Value = ws.Cells(iRow, cPupilLeftCol).Value
        End If
        If ws.Cells(iRow, cPupilRightCol).Value > 0# Then
            ws.Cells(iRow, cInterpRightCol).Value = ws.Cells(iRow, cPupilRightCol).Value
        End If
    Next iRow

    'interpolate left
    iStartRow = ws.Cells(1, cPupilLeftCol).End(xlDown).Row
    For iRow = iStartRow To iLastRow
        If ws.Cells(iRow, cPupilLeftCol).Value > 0# Then GoTo NextRowLeft
            
        Set rUp = ws.Cells(iRow, cPupilLeftCol).End(xlUp).EntireRow
        If rUp.Row < 2 Then GoTo NextRowLeft
            
        Set rDown = ws.Cells(iRow, cPupilLeftCol).End(xlDown).EntireRow
        If rDown.Row > iLastRow Then GoTo NextRowLeft
            
        Set rCurrent = ws.Rows(iRow)
        Set rLeftPupil = rCurrent.Cells(1, cInterpLeftCol)
        
        dDown = pvtMakeDateTime(rDown.Cells(1, cDateCol).Value, rDown.Cells(1, cTimeCol).Value)
        dUp = pvtMakeDateTime(rUp.Cells(1, cDateCol).Value, rUp.Cells(1, cTimeCol).Value)
        dCurrent = pvtMakeDateTime(rCurrent.Cells(1, cDateCol).Value, rCurrent.Cells(1, cTimeCol).Value)
        
        
        rLeftPupil.Value = dCurrent - dUp
        rLeftPupil.Value = rLeftPupil * (rDown.Cells(1, cInterpLeftCol).Value - rUp.Cells(1, cInterpLeftCol).Value)
        rLeftPupil.Value = rLeftPupil.Value / (dDown - dUp)
        rLeftPupil.Value = rLeftPupil.Value + rUp.Cells(1, cInterpLeftCol).Value
    
NextRowLeft:
    Next iRow
  
    'interpolate right
    iStartRow = ws.Cells(1, cPupilRightCol).End(xlDown).Row
    For iRow = iStartRow To iLastRow
        If ws.Cells(iRow, cPupilRightCol).Value > 0# Then GoTo NextRowRight
            
        Set rUp = ws.Cells(iRow, cPupilRightCol).End(xlUp).EntireRow
        If rUp.Row < 2 Then GoTo NextRowRight
            
        Set rDown = ws.Cells(iRow, cPupilRightCol).End(xlDown).EntireRow
        If rDown.Row > iLastRow Then GoTo NextRowRight
            
        Set rCurrent = ws.Rows(iRow)
        Set rRightPupil = rCurrent.Cells(1, cInterpRightCol)
        
        dDown = pvtMakeDateTime(rDown.Cells(1, cDateCol).Value, rDown.Cells(1, cTimeCol).Value)
        dUp = pvtMakeDateTime(rUp.Cells(1, cDateCol).Value, rUp.Cells(1, cTimeCol).Value)
        dCurrent = pvtMakeDateTime(rCurrent.Cells(1, cDateCol).Value, rCurrent.Cells(1, cTimeCol).Value)
        
        
        rRightPupil.Value = dCurrent - dUp
        rRightPupil.Value = rRightPupil * (rDown.Cells(1, cInterpRightCol).Value - rUp.Cells(1, cInterpRightCol).Value)
        rRightPupil.Value = rRightPupil.Value / (dDown - dUp)
        rRightPupil.Value = rRightPupil.Value + rUp.Cells(1, cInterpRightCol).Value
    
NextRowRight:
    Next iRow
  
End Sub

Private Function pvtMakeDateTime(D As String, T As String) As Double
    Dim H As Long, M As Long
    Dim S As Double
    
    '123456789012
    '15:04:27.205
    H = CDbl(Left(T, 2))
    M = CDbl(Mid(T, 4, 2))
    S = CDbl(Right(T, 6))
    
    pvtMakeDateTime = CDbl(DateValue(D) + (H / 24#) + (M / 24# / 60#) + S)
End Function

There's still improvements that can be made to this but it's some more ideas for you