Extrapolation over random blank lines

johnpadc

New Member
Joined
Nov 16, 2017
Messages
4
Hi all,

Please can someone offer me some help?
I have the following spreadsheet (below), it has a list of times with associated ranges, the time goes up in seconds (every second) the range if whatever is measured, always decreasing.
Every so often the data received is missed, so I get blank rows.
What I would like to do is have the code to be able to look at the data and fill in the blanks (the blanks appear at random intervals, there is no pattern, and also could be any number of lines missed), extrapolating the data in the range column, the time is easy really.
I have highlighted in red the data I have extrapolated, please note the this is a subset, I could have anything from 1000+ rows, so doing it by hand takes time.

Any help would be appreciated.

Cheers

John

[TABLE="width: 445"]
<tbody>[TR]
[TD]TIME
[/TD]
[TD="colspan: 2"]RANGE(yds)
[/TD]
[/TR]
[TR]
[TD]11:01:04
[/TD]
[TD]5036.7
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11:01:05
[/TD]
[TD]5023.4
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11:01:06
[/TD]
[TD]5001.2
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11:01:07
[/TD]
[TD]4979.4
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11:01:08
[/TD]
[TD]4971.4
[/TD]
[TD]interpolated results from cell B6 to B9
[/TD]
[/TR]
[TR]
[TD]11:01:09
[/TD]
[TD]4963.4
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11:01:10
[/TD]
[TD]4955.4
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11:01:11
[/TD]
[TD]4942.8
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11:01:12
[/TD]
[TD]4943.5
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11:01:13
[/TD]
[TD]4916.7
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11:01:14
[/TD]
[TD]4889.9
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11:01:15
[/TD]
[TD]4881.6
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11:01:16
[/TD]
[TD]4873.3
[/TD]
[TD]interpolated results from cell B13 to B17
[/TD]
[/TR]
[TR]
[TD]11:01:17
[/TD]
[TD]4865
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11:01:18
[/TD]
[TD]4856.7
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11:01:19
[/TD]
[TD]4851
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11:01:20
[/TD]
[TD]4836.7
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11:01:21
[/TD]
[TD]4837.2
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11:01:21
[/TD]
[TD]4815.9
[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
This should work unless its the first cell that Blank.
Code:
[COLOR="Navy"]Sub[/COLOR] MG16Nov23
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Num [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Areas
    c = 0
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Dn
        c = c + 1
        R.NumberFormat = "hh:mm:ss"
        R.Value = DateAdd("s", c, Dn(1).Offset(-1))
        Num = ((Dn(1).Offset(-1, 1) - Dn(Dn.Count).Offset(1, 1)) / (Dn.Count + 1))
        R.Offset(, 1).NumberFormat = "0.0"
        R.Offset(, 1).Value = Dn(1).Offset(-1, 1) - Num * c
    [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
This should work unless its the first cell that Blank.
Code:
[COLOR=Navy]Sub[/COLOR] MG16Nov23
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, R [COLOR=Navy]As[/COLOR] Range, c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Num [COLOR=Navy]As[/COLOR] Double
[COLOR=Navy]Set[/COLOR] Rng = Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks)
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng.Areas
    c = 0
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] R [COLOR=Navy]In[/COLOR] Dn
        c = c + 1
        R.NumberFormat = "hh:mm:ss"
        R.Value = DateAdd("s", c, Dn(1).Offset(-1))
        Num = ((Dn(1).Offset(-1, 1) - Dn(Dn.Count).Offset(1, 1)) / (Dn.Count + 1))
        R.Offset(, 1).NumberFormat = "0.0"
        R.Offset(, 1).Value = Dn(1).Offset(-1, 1) - Num * c
    [COLOR=Navy]Next[/COLOR] R
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick


Wow that was quick - Thank you Mick that works a treat!:-D:-D:-D:laugh:
 
Upvote 0
You're welcome
NB:- If you try to run the code again with no blanks you will get an error, To stop this add the line in red:-
Code:
Dim Rng As Range, Dn As Range, R As Range, c As Long, Num As Double
[B][COLOR=#B22222]On Error Resume Next[/COLOR][/B]
Set Rng = Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks)
 
Upvote 0
Thank you Mick that has helped enormously.
I have now been given the same data, but without the blank lines, so need to add the blank lines when the time (seconds) are not consecutive, i.e. [TABLE="width: 64"]
<tbody>[TR]
[TD="class: xl63, width: 64"]10:26:28[TABLE="width: 64"]
<tbody>[TR]
[TD="class: xl63, width: 64"]10:26:29
[TABLE="width: 64"]
<tbody>[TR]
[TD="class: xl63, width: 64"]10:26:31
[TABLE="width: 64"]
<tbody>[TR]
[TD="class: xl63, width: 64"]10:26:35[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
I would need to add one blank line between 29 and 31 seconds and three blank lines between 31 and 35, and use your code above to fill in the data.
I can do this using For loops, by detecting the difference, but they are in time format (have to stay like that), and my current attempts do not pick this up!
Any help is very much appreciated.

Cheers
 
Upvote 0
Try this for Data starting in "A1":-
Code:
[COLOR="Navy"]Sub[/COLOR] MG22Nov22
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] Dif [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Lst = Range("A" & Rows.Count).End(xlUp).Row
[COLOR="Navy"]For[/COLOR] n = Lst To 2 [COLOR="Navy"]Step[/COLOR] -1
    [COLOR="Navy"]With[/COLOR] Range("A" & n)
        Dif = DateDiff("s", .Offset(-1), .Value)
            [COLOR="Navy"]If[/COLOR] Dif > 1 [COLOR="Navy"]Then[/COLOR] .Resize(Dif - 1).Insert shift:=xlDown
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi Mick,

Thank you very much again - it worked a treat.
I was going from top to bottom, which made it rather messy, should have thought about bottom to top!!:eeek:

Thanks alot.
Cheers

John:beerchug:
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,324
Members
452,635
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top