I'm attempting to make a PTO calculator, in which a user would click a date or set of dates and the spreadsheet would spit out what the remaining PTO balance would be if vacation time was taken during those days. I'd like the dates & values that were selected to remain present on the sheet if the month changes, so that someone could hypothetically plan a full year ahead. Screenshot of what this looks like below.
This is the VBA I've written so far, which takes a single selected date and copies it over the side, where someone could enter how many hours they'd like to take that day (1.0-8.0).The goal being that the dates would present themselves in a linear/easy to read fashion next to the calendar, all with a single click.
(Sorry, formatting was a little weird. And I've been adding & deleting pieces of it so it's probably messy in general.)
So basically I just need this action to repeat n times, each time copying the date one more cell to the right, which I'm having trouble conceptualizing. Any guidance would be appreciated!
I can also share the workbook itself if that would be helpful.
Dim originalCell As Range
Sub CopyAndReturn()
Dim currentCell As Range
Dim destinationCell As Range
Set originalCell = ActiveCell
Range("C10:I15").Select
Selection.Copy
Range("D18").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.Goto originalCell
Set currentCell = ActiveCell
currentCell.Offset(8, 0).Select
Set destinationCell = ThisWorkbook.Sheets("Sheet1").Range("L10")
destinationCell.Value = ActiveCell.Value
Selection.NumberFormat = "m/d/yyyy"
Range("L11").Select
End Sub
Here's what I'd maybe do:
Sub AddVacationDates()
Dim c As Range, rng As Range, ws As Worksheet, okSel As Boolean
Set ws = ThisWorkbook.Worksheets("Calendar")
If Selection.Parent.Name = ws.Name Then 'make sure we're on the correct sheet....
Set rng = Application.Intersect(Selection, ws.Range("C10:I15"))
If Not rng Is Nothing Then 'selection inside calendar range?
For Each c In rng.Cells 'check each selected cell inside the calendar
If Len(c.Value) > 0 Then 'cell has a value?
With ws.Cells(10, Columns.count).End(xlToLeft).offset(0, 1) 'next empty cell in "Selected dates"
.NumberFormat = "m/d/yyyy"
.Value = c.Value
End With
okSel = True 'flag at least one date was captured
End If
Next c
End If
End If
If Not okSel Then 'nothing copied over?
MsgBox "You must first select one or more dates in the calendar!", _
vbInformation, "No dates selected"
Exit Sub
End If
End Sub