Fill the missing cells with date

[Aussiebear]

I would like to create a shortcut to fill missing cells with a date value ( copy of previous date above).

	A	B
1	1/1/15
2
3
4
5	2/1/15
6
7
8	3/1/15
9

The number of cells between the dates is mostly 3 but sometimes only 2, due to the tide times that I'm entering in a table. What i'm hoping is that when I enter a new date in Column A the above cells are filled with the above value date. Is this possible?

[SamT]

So when you enter a date in "A10" you want "A9" to read 3/1/15?

Private Sub WorkSheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub

If Target.Offset(-1, 0) = "" Then
  Set Target = Target.End(xlUp)
  If Target.Row = 1 Then Goto Oops
  Do
    Target.Offset(1) = Target
    Set Target = Target.Offset(1)
  Loop While Target.Offset(1) <> ""
End If
Exit Sub
Oops:
MsgBox "Auto Date Fill won't work without a date in A2!"
End Sub

[Aussiebear]

[QUOTE=SamT;319531]So when you enter a date in "A10" you want "A9" to read 3/1/15?


Yes

[SamT]

Is no Code there???

The only thing I fogot was

If Target.Row = 1 Then Exit Sub
If Target.Row = 2 Then Target = Date

Just for the very first time you use it.

[SamT]

g'nite mate

[Aussiebear]

Well I'm flattered. An American knows where Australia is and what time of day it is........ But then you should being a product of Exmouth and having married a good ol' Aussie girl.


Man, if that doesn't get a bite out of Sam

[Aussiebear]

Grrr..... now I've got to go down on bended knee and ask how the code works.......

[SamT]

New and improved version

     Private Sub WorkSheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Row <= 2 Then Exit Sub

If Target.Offset(-1, 0) = "" Then
  Set Target = Target.End(xlUp)
  If Target.Row = 1 Then Goto Oops
  Do
    Target.Offset(1) = Target
    Set Target = Target.Offset(1)
  Loop While Target.Offset(1) <> ""
End If
Exit Sub
Oops:
MsgBox "Auto Date Fill won't work without a date in A2!"
End Sub

At newest dated cell
If next cell up is empty, go up to non empty cell
Fill cell below (We know its empty or we would not have gone up
Move down to cell just filled
If cell below is empty, fill it and move down to it
Repeat til cell below is not empty

You owe me a beer, Ted, that's a lot of typing.
ps: Zavra says "Hey."

[Aussiebear]

Thanks Sam, can you be here by 4pm?

@Zavra Hey Hey Hey

[Aussiebear]

Any warranty on this code Sam? I think I broke it......

Oops 1. It loops once only above or below the new date
Oops 2. If you enter a new date 2 cells below the last date entry it fill above and below cells but also changes all the cell values to the last date.

I'm entering tide times and heights in a table, and from your experience you'd understand that sometimes we have four tides a day and on occasions only three

	Date	Time	Status	Height
1	4/1/15	0452	Low	0.46
2		1115	High	4.84
3		1753	Low	0.49
4		2339	High	3.92
5	5/1/15	0541	Low	0.71
6		1204	High	4.58
7		1840	Low	0.66
8	6/1/15	0032	High	3.82

When I enter a date (5/1/15) in Cell A5, the code needs to fill A2, A3 & A4 with the A1 value (4/1/15). Same scenario with the next new date (6/1/15) which was entered into cell A8 because the 5th was a three tide day, cells A6 & A7 need to be filled with the date value 5/1/15

[SamT]

Ted, it was self firing. I forgot to disable events. This one sould be ok, but I really dont like it. The logic is built on whether or not some Cell is empty or not. It has built in errors for which I cant predict the results of. But, It does what you asked for.

Private Sub WorkSheet_Change(ByVal Target As Range)
  If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
  If Target.Count > 1 Then Exit Sub
  If Target.Row <= 2 Then Exit Sub
  Application.EnableEvents = False
  
  If Target.Offset(-1, 0) = "" Then
    Set Target = Target.End(xlUp)
    Do
      Target.Offset(1) = Target
      Set Target = Target.Offset(1)
    Loop While Target.Offset(1) <> ""
  End If
  
  Application.EnableEvents = True
End Sub

I like this one, it does what you need done, but it's logic is based on the fact that you entered a new time. It too has a built in error. IF you forget to start a new day with the new date , this will use yesterdays date. This error can be avoided with a bit more code. I would not offer it to anybody else, but I figger you know how deal with it.

And I keep running into you at midnight, which is really killing me booty sleep.

Private Sub WorkSheet_Change(ByVal Target As Range)
  If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
  If Target.Count > 1 Then Exit Sub
  If Target.Row <= 2 Then Exit Sub
  Application.EnableEvents = False

  If Target.Offset(0, -1) = "" Then _
  Target.Offset(0, -1) = Target.Offset(-1, -1)
  
  Application.EnableEvents = True
End Sub

[snb]

I don't want to wake you up...

Sub M_snb()
    On Error Resume Next
    
    For Each ar In Cells(1).CurrentRegion.Columns(1).SpecialCells(4).Areas
       ar.Value = ar.Cells(1).Offset(-1)
    Next
End Sub

[Aussiebear]

Hell snb, you just join me me for a beer any time of the day... I'm not ambitious by any means....

[Aussiebear]

@ SNB you code is too short, no explanations therefore I'm going to ignore it.

You and I have had this discussion before..... Unless you are prepared to explain the code, we can't learn from it.

[Aussiebear]

And I keep running into you at midnight, which is really killing me booty sleep.

Perfectly understandable given you live in the wrong hemisphere......... you need b broad shoulders given we carry you layabouts!

[Aussiebear]

and just in case you Colonial offspring think you are something...... we convicts just flogged you at your own game...... read this and weep boys!

[snb]

I don't see any explanation in the code SamT provided.

If I have to explain this simple code to a VBAX Guru you surely would feel offended.

[apo]

Hi..

@ SNB you code is too short, no explanations therefore I'm going to ignore it.

imo.. we can learn from it by studying its structure and resultant output.

And... Maybe this too...

Private Sub CommandButton1_Click()
    Dim x, i As Long
    With Range("A1").CurrentRegion.Columns(1)
        x = Application.Transpose(.Offset(1).Resize(.Rows.Count - 1))
        For i = LBound(x) To UBound(x)
            If x(i) = vbNullString Then x(i) = x(i - 1)
        Next i
        .Offset(1).Resize(UBound(x)).Value = Application.Transpose(x)
    End With
End Sub

[SamT]

Ted, Glad you like it. You are seeing its limitations, yeah?
Hint: If IdenticalDatesAbove.Count = 4 Then MsgBox "This Date Can't Be Right!"

If you ever start deciphering snb's code, it can get addictive. Kinda like working the New York Times Sunday Crossword, when you need Webster's and Roget's to start. It will definitely improve your skills, but, it's only for the stubborn.

My first, snb's and apo's code all do what you want in the manner that you asked for. ie. fill in the blanks with the value above. The main differences are that I assume there is only one empty area, snb takes no chances and works on all possible empties, apo works on the entire column except A1.

My second offering doesn't do that. Whenever you add a time, if the adjacent date cell is empty, it adds the date from above.

snb, Whaddaya mean? My code is always totally self-explanatory.