User Profile
joshbernabe
Copper Contributor
Joined 5 months ago
User Widgets
Recent Discussions
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 SubMacro overwrites first row instead of pasting the data on the next row.
I'm trying to get this macro to paste data into the next row but all it does is overwrite the the first row. Can anyone help me please? Sub ValidateExportData() ' ' ValidateExportData Macro ' ' Keyboard Shortcut: n/a ' Application.ScreenUpdating = False Application.EnableEvents = False Dim DataSource As Worksheet Dim DataDestination As Worksheet Dim LastRow As Long Dim PasteRow As Long On Error GoTo CleanUp ' Open the destination workbook Dim TaskCalendar As Workbook Set TaskCalendar = Workbooks.Open("S:\Task Management Calendar System\Task Calendar.xlsx") ' Set worksheets Set DataSource = Workbooks("Analysis Request Form.xlsm").Worksheets("Analysis Request Form") Set DataDestination = TaskCalendarWB.Worksheets("2025") ' Find the last row and move to the next row LastRow = DataDestination.Range("D" & Rows.Count).End(xlUp).Row + 1 ' Copy and paste values from the source to the destination DataDestination.Cells(PasteRow, 4).Value = DataSource.Range("E11").Value ' Paste in column D DataDestination.Cells(PasteRow, 5).Value = DataSource.Range("E12").Value ' Paste in column E ' Optional: Save and close the destination workbook TaskCalendarWB.Close SaveChanges:=True CleanUp: Application.CutCopyMode = False Application.EnableEvents = True Application.ScreenUpdating = True If Err.Number <> 0 Then MsgBox "An error occurred: " & Err.Description End If End Sub
