Forum Discussion

joshbernabe's avatar
joshbernabe
Copper Contributor
Aug 07, 2024

Advice for a Dynamic Worksheet Selector

Hello, I am trying to make my code automatically paste data on all relevant dates. My issue is that it does no do this due to how my code currently works.

 

When the dates in C33:C59 cross over from 2025 to 2026 and beyond it should paste on the relevant dates but all I get is "Object variable or With block variable not set" because worksheet 2026 or 2027 is not set. So, is there a way for it to dynamically select the relevant worksheet using the date in C33:C59?

 

 

My current code for more context:

Option Explicit

Sub ValidateExportData()
Static LastProcessedRow As Long ' Static variable to keep track of the last processed row
Dim RequestForm As Workbook
Dim TaskCalendar As Workbook
Dim DataSource As Worksheet
Dim DataDestination As Worksheet

Dim TrialOwner As Range
Dim TrialTitle As Range
Dim TrialDate As Range

Dim LastRowDate As Long
Dim CurrentDate As Date
Dim OrangeColor As Long
Dim TargetRow As Long
Dim DateRange As Range
Dim Cell As Range
Dim DateCell As Range
Dim isWeekend As Boolean
Dim msg As String
Dim InsertRow As Long

On Error GoTo ErrorHandler ' Basic error handling

' Initialize variables and open workbooks
Set RequestForm = ThisWorkbook
Set TaskCalendar = Workbooks.Open("S:\Site\Department\Person1\Person2\Task Management Calendar System\Task Calendar.xlsx")
Set DataSource = RequestForm.Worksheets("Analysis Request Form")
Set DataDestination = TaskCalendar.Worksheets("2025")

Set TrialOwner = DataSource.Range("E11")
Set TrialTitle = DataSource.Range("E12")
Set TrialDate = DataSource.Range("E14")

OrangeColor = RGB(255, 165, 0) ' Color code for orange

LastRowDate = DataDestination.Range("B" & DataDestination.Rows.Count).End(xlUp).Row

' Set the range of dates to match
Set DateRange = DataSource.Range("C33:C59")

' Initialize the LastProcessedRow if it's the first run
If LastProcessedRow = 0 Then
LastProcessedRow = 2 ' Assuming data starts from row 2
End If

' Disable screen updating for performance
Application.ScreenUpdating = False

' Check if there are rows left to process
If LastProcessedRow <= LastRowDate Then
' Process the current row
CurrentDate = DataDestination.Range("B" & LastProcessedRow).Value

' Ensure CurrentDate is a date before proceeding
If IsDate(CurrentDate) Then
' Check if the cell color is not orange
If DataDestination.Range("B" & LastProcessedRow).Interior.Color <> OrangeColor Then
' Loop through each date in the range C33:C59
For Each Cell In DateRange
If IsDate(Cell.Value) Then
' Check if the date is a Saturday or Sunday
isWeekend = Weekday(Cell.Value, vbSunday) = vbSaturday Or Weekday(Cell.Value, vbSunday) = vbSunday

If isWeekend Then
msg = "Weekend date found: " & Cell.Address & " with value " & Cell.Value
MsgBox msg

' Insert a new row based on the weekend date
InsertRow = LastProcessedRow
If Weekday(Cell.Value, vbSunday) = vbSaturday Then
' Insert a new row below Friday
InsertRow = DataDestination.Columns("B").Find(What:=Cell.Value - 1, LookIn:=xlValues, LookAt:=xlWhole).Row + 1
DataDestination.Rows(InsertRow).FormatConditions.Delete
ElseIf Weekday(Cell.Value, vbSunday) = vbSunday Then
' Insert a new row below Monday
InsertRow = DataDestination.Columns("B").Find(What:=Cell.Value + 1, LookIn:=xlValues, LookAt:=xlWhole).Row + 1
DataDestination.Rows(InsertRow).FormatConditions.Delete
End If

' Insert new row and paste data
DataDestination.Rows(InsertRow).Insert Shift:=xlDown
DataDestination.Rows(InsertRow).FormatConditions.Delete
DataDestination.Cells(InsertRow, 4).Value = TrialOwner.Value
DataDestination.Cells(InsertRow, 5).Value = TrialTitle.Value

Else
' Find the row matching the date in C33:C59
Set DateCell = DataDestination.Range("B:B").Find(What:=Cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not DateCell Is Nothing Then
TargetRow = DateCell.Row

' Check if data already exists in the target row
If Application.WorksheetFunction.CountA(DataDestination.Range("B" & TargetRow & ":B" & TargetRow)) > 0 Then
' Insert a new row below the matched row
DataDestination.Rows(TargetRow + 1).Insert Shift:=xlDown
TargetRow = TargetRow + 1 ' Update TargetRow to the new row
' Clear conditional formatting in the new row
DataDestination.Rows(TargetRow).FormatConditions.Delete
End If

' Paste the data into the correct row
With DataDestination
.Range("D" & TargetRow).Value = TrialOwner.Value
.Range("E" & TargetRow).Value = TrialTitle.Value
End With
End If
End If
End If
Next Cell
End If
End If

' Move to the next row
LastProcessedRow = LastProcessedRow + 1
Else
MsgBox "All rows have been processed."
End If

Application.ScreenUpdating = True
Application.CutCopyMode = False ' Clear the clipboard

TaskCalendar.Save
' TaskCalendar.Close SaveChanges:=True

Exit Sub

ErrorHandler:
MsgBox "An error occurred: " & Err.Description
If Not TaskCalendar Is Nothing Then
TaskCalendar.Close SaveChanges:=False
End If
Application.ScreenUpdating = True

End Sub

 

  • joshbernabe 

    I think the logic of the code is reversed. You first look as the DataDestination sheet and then loop through the dates in DataSource range C33:C59.

    You should start by looping through C33:C59, and for each cell set DataDestination to the sheet corresponding to the year in that cell.

  • joshbernabe 

    I think the logic of the code is reversed. You first look as the DataDestination sheet and then loop through the dates in DataSource range C33:C59.

    You should start by looping through C33:C59, and for each cell set DataDestination to the sheet corresponding to the year in that cell.

Resources