1

I have a stack of data like this:

Tidal Time  Tidal Height
00:00:00    4.40
01:00:00    
02:00:00    
03:00:00    
04:00:00    
05:00:00    
06:00:00    2.00
07:00:00    
08:00:00    
09:00:00    
10:00:00    
11:00:00    4.50
12:00:00    
13:00:00    
14:00:00    
15:00:00    
16:00:00    
17:00:00    
18:00:00    2.10
19:00:00    
20:00:00    
21:00:00    
22:00:00    
23:00:00    4.40

Then using this code I trend the values starting from the bottom:

Sub TrendValues()

Set LastCell = Sheets("Vessels").Cells(ActiveSheet.Rows.Count, 2).End(xlUp)

Do While LastCell.Row > 2

    If LastCell.Offset(-1, 0) = "" Then
        Set NonEmptyCellAboveLastCell = LastCell.End(xlUp)
    Else
        Set NonEmptyCellAboveLastCell = LastCell.Offset(-1, 0)
    End If

    If NonEmptyCellAboveLastCell.Row > 1 Then
        Set RangeToFill = Sheets("Vessels").Range(NonEmptyCellAboveLastCell, LastCell)
        RangeToFill.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Trend:=True

        If NonEmptyCellAboveLastCell.Offset(-1, 0) = "" Then
            Set LastCell = NonEmptyCellAboveLastCell.End(xlUp)
        Else
            Set LastCell = NonEmptyCellAboveLastCell.Offset(-1, 0)
        End If

    Else
        Set LastCell = Sheets("Vessels").Range("B1")
    End If
Loop

End Sub

This fills the table out like this:

Tidal Time  Tidal Height
00:00:00    4.40
01:00:00    
02:00:00    
03:00:00    
04:00:00    
05:00:00    
06:00:00    2.00
07:00:00    2.50
08:00:00    3.00
09:00:00    3.50
10:00:00    4.00
11:00:00    4.50
12:00:00    
13:00:00    
14:00:00    
15:00:00    
16:00:00    
17:00:00    
18:00:00    2.10
19:00:00    2.56
20:00:00    3.02
21:00:00    3.48
22:00:00    3.94
23:00:00    4.40

So this generally only works partially and I'm not quite sure why.
As you can tell by the table it just decides to cause gaps and not trend for me at all. The code works if there is no value in column B at the top or bottom. But in some cases I need to automatically fill in the start and end values, and this is where the code breaks down.
And to be fair I have to run this code twice to properly fill in the entire table regardless of whether the start and end fields in column B are filled or not. I'm missing the entire function of the code and so therefore I have no idea how to edit to fix the problem.
Does anyone see any glaring and obvious problem areas and can suggest additions or subtractions to the code to fix this?
Even explaning the function of the code in steps would be helpful.
Thank you in advance!

Community
  • 1
  • 1
Savagefool
  • 223
  • 1
  • 4
  • 16
  • To give you a general tip: Look for patterns: Your error has something do with "6". See 6 o'clock, 6 free Cells, 6 filled Cells. So somehow your error is linked to some bad calculation, like 2*3 where you wanted something else. Maybe you'll find something yourself first. :) – Tom K. Sep 17 '15 at 12:22
  • a few `Debug.Print` would surely help you. eg: `debug.print RangeToFill.Address` – iDevlop Sep 17 '15 at 12:26

2 Answers2

0

I rewrote you routine another way, it seems to work ok. Some error handling could surely be added...up to you.

Sub TrendValues()
    Dim rng As Range, ar As Range, toFill As Range
    Set rng = Intersect(Range("a1").CurrentRegion, Range("B:B")).SpecialCells(xlCellTypeBlanks)
    For Each ar In rng.Areas
        'add 1 cell above and one below
        Set toFill = ar.Offset(-1, 0).Resize(ar.Rows.Count + 2, 1)
        toFill.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Trend:=True
    Next ar
End Sub
iDevlop
  • 24,841
  • 11
  • 90
  • 149
  • Thank you for the quick reply, I get an object defined or application defined error when I try to run this. `Set toFill = ar.Offset(-1, 0).Resize(ar.Rows.Count + 2, 1)` is the line highlighted. – Savagefool Sep 17 '15 at 13:30
  • The worked on the sample I built when you asked...and destroyed in the meantime. You should try adding something like `debug.print ar.address` before the faulty line, or add some `on error` code. In other words, debugging. Sorry, no time for more today ! – iDevlop Sep 22 '15 at 13:21
  • @Savagefool : I added an Intersect() to make sure we only get those Areas in B column. Not tested. – iDevlop Sep 23 '15 at 08:53
  • @Savagefool : did you make progress on this ? – iDevlop Sep 23 '15 at 08:53
  • Ah yes I did, Posted it as a new answer. – Savagefool Sep 24 '15 at 13:08
0
Sub ErrorFix()
Dim Bounds As Range
Set Bounds = Range("A1").CurrentRegion

Dim c As Range
Set c = Range("B2")

Do While c.Row < Bounds.Rows(Bounds.Rows.Count).Row
  If IsEmpty(c.Offset(1, 0).Value) Then
    Dim RangeToFill As Range
    Set RangeToFill = Application.Intersect(Range(c, c.End(xlDown)), Bounds)

    RangeToFill.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Trend:=True
    Set c = RangeToFill.Cells(RangeToFill.Cells.Count)
  Else
    Set c = c.End(xlDown)
  End If
Loop
End Sub

This fullfilled the requirements of the question.

Savagefool
  • 223
  • 1
  • 4
  • 16