Extrapolation over random blank lines

[johnpadc]

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

TIME	RANGE(yds)
11:01:04	5036.7
11:01:05	5023.4
11:01:06	5001.2
11:01:07	4979.4
11:01:08	4971.4	interpolated results from cell B6 to B9
11:01:09	4963.4
11:01:10	4955.4
11:01:11	4942.8
11:01:12	4943.5
11:01:13	4916.7
11:01:14	4889.9
11:01:15	4881.6
11:01:16	4873.3	interpolated results from cell B13 to B17
11:01:17	4865
11:01:18	4856.7
11:01:19	4851
11:01:20	4836.7
11:01:21	4837.2
11:01:21	4815.9

<tbody>
</tbody>

 

[MickG]

This should work unless its the first cell that Blank.

[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

 

[johnpadc]

This should work unless its the first cell that Blank.

[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!

 

[MickG]

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:-

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)

 

[johnpadc]

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.

10:26:28 10:26:29 10:26:31 10:26:35 <tbody> </tbody> <tbody> </tbody> <tbody> </tbody>

<tbody>
</tbody>

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

 

[MickG]

Try this for Data starting in "A1":-

[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

 

[johnpadc]

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!!

Thanks alot.
Cheers

John

 

[MickG]

You're welcome