Home > Software design >  Search range for string, change values of adjacent cells
Search range for string, change values of adjacent cells

Time:12-24

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.

Timesheet layout

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!

  1. I converted your Timetable range to a table object
  2. I created a table for the weekday start and finish times
  3. 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

enter image description here

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
  • Related