PDA

View Full Version : [SOLVED] Linear interpolation using VBA for empty cells in a row



LauraF
02-19-2015, 07:32 AM
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,12873

MINCUS1308
02-19-2015, 01:56 PM
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
02-19-2015, 02:28 PM
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
02-19-2015, 02:43 PM
12877
Above is the equation for linear interpolation.
and you want to apply this equation when data is missing for P2?

LauraF
02-19-2015, 02:59 PM
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
02-19-2015, 05:19 PM
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
02-20-2015, 03:09 AM
Wow p45cal!!!!! It works perfectly!!!! I have no enough words to thank you!!!! You've really HELPED me!!!!Thanks a lot!

Regards,
LauraF.

snb
02-20-2015, 07:23 AM
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
02-20-2015, 07:37 AM
p45cal thats exactly what i was going to say! :p
looks like they got you sorted out alot better than I could have done.

Good luck with your pupil study

Paul_Hossler
02-20-2015, 01:16 PM
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