I seem to be stuck on what would seem a very simple bit of code. I'm very new to VB so if I've done something very dumb please be patient.
This is for a timesheet, I log my start and finish hours each day all year.
So each year I make a new copy of the Excel file and I want to overwrite the times I entered the previous year with a default start at 7am finish at 4:30pm I could probably do it direct in Excel with 'Vlookup' but this timesheet is a bit of a project to skill up in VBA
The 'Begin new sheet' button opens a user form for some other input that all works fine.
Within the Private Sub TSSubmitButton_Click() I've defined the ranges and strings I need and made some For Each Cell in Range Find Monday
, then write the variable attached to Monday Start Time (07:00:00) and Monday Finish Time (16:45:00)
(only included Monday and Tuesday for example)
Debug doesn't flag any errors and when the code is run (i.e. userform submit button clicked) nothing happens, all the time values remain as they were.
I've tried turning the 'Monday as String' to 'Monday as Date'
I've tried not having the Find(DayCell.Value)
Private Sub TSSubmitButton_Click()
' Definitions
Dim DayRange As Range
Dim DayCell As Range
Set DayRange = Sheet1.Range("A2:A426")
Set DayCell = DayRange(1, 1)
Dim MonStartTime As String
Dim MonFinishTime As String
Dim TueStartTime As String
Dim TueFinishTime As String
Dim WedStartTime As String
Dim WedFinishTime As String
Dim ThuStartTime As String
Dim ThuFinishTime As String
Dim FriStartTime As String
Dim FriFinishTime As String
Dim SatStartTime As String
Dim SatFinishTime As String
Dim SunStartTime As String
Dim SunFinishTime As String
Dim Monday As String
Dim Tuesday As String
Dim Wednesday As String
Dim Thursday As String
Dim Friday As String
Dim Satday As String
Dim Sunday As String
MonStartTime = "07:00:00"
MonFinishTime = "16:45:00"
TueStartTime = "07:00:00"
TueFinishTime = "16:45:00"
WedStartTime = "07:00:00"
WedFinishTime = "16:45:00"
ThuStartTime = "07:00:00"
ThuFinishTime = "16:45:00"
FriStartTime = "00:00:00"
FriFinishTime = "00:00:00"
SatStartTime = "00:00:00"
SatFinishTime = "00:00:00"
SunStartTime = "00:00:00"
SunFinishTime = "00:00:00"
' loops the if statement through all cells and sets the time in adjecnt cells
For Each DayCell In DayRange.Find(DayCell.Value)
If DayCell = Monday Then
DayCell.Offset(, 2).Value = MonStartTime
DayCell.Offset(, 7).Value = MonFinishTime
End If
' loops the if statement through all cells and sets the time in adjecnt cells
For Each DayCell In DayRange.Find(DayCell.Value)
If DayCell = Tuesday Then
DayCell.Offset(, 2).Value = TueStartTime
DayCell.Offset(, 7).Value = TueFinishTime
End If
Next
Unload Me
End Sub
CodePudding user response:
I don't know if you are going to like this solution!
- I converted your Timetable range to a table object
- I created a table for the weekday start and finish times
- Using XLOOKUP formula, I get the start and finish times to the start and finish columns. Instead of XLOOKUP You can use VLOOKUP or INDEX & MATCH
Sub ResetTimesheet()
Dim ws As Worksheet
Dim olWkDay As ListObject
Dim olTimetable As ListObject
Dim olCol As Long
Dim olRng As Range
Set ws = ActiveSheet
'Tables
Set olWkDay = ws.ListObjects("tbWkDayTime")
Set olTimetable = ws.ListObjects("tbTimetable")
''''''''''''''''''''''''''''''''''''''''''''
' Start column
''''''''''''''''''''''''''''''''''''''''''''
olCol = olTimetable.ListColumns("Start").Index
Set olRng = olTimetable.ListColumns(olCol).DataBodyRange
' Clear column contents
olRng.ClearContents
' Apply formula: you can use VLookup or Index & Match
olRng.Formula2R1C1 = "=XLOOKUP([@Weekday],tbWkDayTime[Weekday],tbWkDayTime[StartTime])"
' Copy to values
olRng.Copy
olRng.PasteSpecial xlPasteValues
Application.CutCopyMode = False
''''''''''''''''''''''''''''''''''''''''''''
' Finish column
''''''''''''''''''''''''''''''''''''''''''''
olCol = olTimetable.ListColumns("Finish").Index
Set olRng = olTimetable.ListColumns(olCol).DataBodyRange
' Clear column contents
olRng.ClearContents
' Apply formula: you can use VLookup or Index & Match
olRng.Formula2R1C1 = "=XLOOKUP([@Weekday],tbWkDayTime[Weekday],tbWkDayTime[FinishTime])"
' Copy to values
olRng.Copy
olRng.PasteSpecial xlPasteValues
Application.CutCopyMode = False
' Clear
Set olWkDay = Nothing
Set olTimetable = Nothing
End Sub
Change the For..Next like this
For Each DayCell In DayRange
If DayCell.Value = "Monday" Then DayCell.Offset(, 2).Value = MonStartTime: DayCell.Offset(, 5).Value = MonFinishTime: GoTo nextDay
If DayCell.Value = "Tuesday" Then DayCell.Offset(, 2).Value = MonStartTime: DayCell.Offset(, 5).Value = MonFinishTime: GoTo nextDay
nextDay:
Next