Automatically Insert Dates For Week Off One Day Entry

C

CVinje

I'm working on a spreadsheet that includes a static Sunday through Saturday
list in one row. Above that row, I have a place to enter the dates for each
day. I'm looking for a way to allow entry into any of the seven cells for the
date, and for the remaining six cells to auto calculate and populate the
date. Here's an example of the layout:

Row A: |Date|Date|Date|Date|Date|Date|Date|
Row B: |Mon|Tue|Wed |Thur| Fri | Sat |Sun |

Again, I want to be able to put a known date in any of the cells above the
day of the week it corresponds with (the cells labeled "Date"), and have the
other 6 cells auto populate the date.

Any help is appreciated,

CVinje
 
B

Bernard Liengme

If A1 holds Monday's date then in B1 use =A1+1 to get Tuesday's date
Or have I missed something?
best wishes
 
C

CVinje

That is close, but what I need is a way to allow the user to type into any of
the cells that would contain a date, be it Monday or Saturday, and then have
the other cell dates populate based off of that date (i.e. - subtract / add
as necessary). I'm thinking I'd probably need to use a macro / user input box
- I don't really know.

Thanks for the response though!
 
B

Bernard Liengme

You cannot have formulas in cells AND have a user type into the cell because
the scheme would be ruined. Yes, you do need VBA. Post your question to the
msnews.public.excel.programming newsgroup
best wishes
 
B

Bernard Liengme

Sorry I was too busy before. This seems to work well.
Right click the tab of the worksheet with the dates; use View Code; copy the
subroutine to the module

Private Sub Worksheet_Change(ByVal Target As Range)
' Enter date in row 1 If date and weekday of row 2 agree then subroutine
' will full row 1 with dates

If Application.Intersect(Target, Range("A1:G1")) Is Nothing Then Exit Sub

If Not (IsDate(Target)) Then Exit Sub

Application.EnableEvents = False
Daytest = Weekday(Target.Value, 2)
Myweekday = Mid(Target.Address(ReferenceStyle:=xlR1C1), 4, 1)

If Daytest - Myweekday <> 0 Then
MsgBox "Date and weekday do not agree"
For j = 1 To 7
Cells(1, j) = ""
Next j
Else
For j = 1 To 7
Cells(1, j) = Target.Value - Myweekday + j
Next j
End If
Application.EnableEvents = True
End Sub

best wishes
 
C

CVinje

Bernard - Thank you very much for the follow-up reply with the code - it
works perfectly when the data is contained in the range specified (A1:G1);
however, my data is in a different range on the sheet and I'm having problems
modifying the code to account for this. I've gone through, attempting to
understand what each part of the code does, but have failed to comprehend. I
hope you could help me once again - here is where my data is contained on the
sheet, etc.

L M N O P Q R
7| Blank Blank Blank Blank Blank Blank Blank
8| Sun Mon Tue Wed Thur Fri Sat

I was able to change the code provided to account for the week starting on
Sunday, but when I try to use the code with the information in the cells
above, I only get the message box the code calls for, or the error: type
mismatch. I've spent much time trying to understand the code so I wouldn't
have to bother you for more information, but I'm unable to. Any help is
appreciated. **Note: the "Blank" in the cells above is where the dates would
be entered.

CVinje
 
B

Bernard Liengme

Here we go

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Range("L7:R7")) Is Nothing Then Exit Sub

If Not (IsDate(Target)) Then Exit Sub

Application.EnableEvents = False
Daytest = Weekday(Target.Value, vbSunday)
Myweekday = Target.Column - 11

If Daytest - Myweekday <> 0 Then
MsgBox "Date and weekday do not agree"
For j = 1 To 7
Cells(7, j + 11) = ""
Next j
Else
For j = 1 To 7
Cells(7, j + 11) = Target.Value - Myweekday + j
Next j
End If
Application.EnableEvents = True
End Sub


best wishes
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top