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!
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
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.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.