PDA

View Full Version : Fill the missing cells with date



Aussiebear
01-14-2015, 06:16 PM
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
01-14-2015, 10:14 PM
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
01-14-2015, 11:43 PM
[QUOTE=SamT;319531]So when you enter a date in "A10" you want "A9" to read 3/1/15?


Yes

SamT
01-15-2015, 12:15 AM
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
01-15-2015, 12:41 AM
g'nite mate

Aussiebear
01-15-2015, 03:06 AM
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 :devil2:

Aussiebear
01-15-2015, 03:10 AM
Grrr..... now I've got to go down on bended knee and ask how the code works.......

SamT
01-15-2015, 08:22 AM
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
01-15-2015, 04:10 PM
Thanks Sam, can you be here by 4pm?

@Zavra Hey Hey Hey

Aussiebear
01-15-2015, 05:37 PM
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
01-15-2015, 11:10 PM
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
01-16-2015, 01:30 AM
I don't want to wake you up...:hi:


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
01-16-2015, 03:43 AM
Hell snb, you just join me me for a beer any time of the day... I'm not ambitious by any means....

Aussiebear
01-16-2015, 03:51 AM
@ 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
01-16-2015, 03:59 AM
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
01-16-2015, 04:02 AM
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
01-16-2015, 04:27 AM
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
01-16-2015, 06:31 AM
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
01-16-2015, 08:51 AM
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. :D

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