Need help with VBA copy if condition is met and clear range error message

[DW09460]

If "On PTO", Column AF any cell 23 thru 35 = True, copy Cell A23 and Cell AC23 and paste to Sheet "<1 YR Not PTO", Cell A5 and Cell B5 if empty otherwise next empty row. I then want to clear content on Sheet "On PTO" in Cells A:Z of the row that held True, but keep formulas in place for new entries.

Sheet6="On PTO" has Name in (A23-A35), Date in (AC23-35), True/False in (AF23-35)
Sheet8="<1 YR Not PTO" (A5-A30) Name, (B5-B30) Date, A5+6 thru A29+30 are merged. Same for Column B.

Here is what I’m working with but can’t figure out where I’m going wrong. Data already on sheet "<1YR Not PTO" is being overwritten and I need that data to stay. As for the clear contents I'm receiving a run error. Hope someone can help.

Sub MyCopyPasteClear()

Dim lastRow As Long
Dim myRow As Long
Dim myCopyRow As Long

myCopyRow = 5

lastRow = Sheets("On PTO").Cells(Rows.Count, "AF").End(xlUp).Row

Application.ScreenUpdating = False

For myRow = 23 To 35

If Sheets("On PTO").Cells(myRow, "AF") = "True" Then
Sheets("<1 YR Not PTO").Cells(myCopyRow, "A") = Sheets("On PTO").Cells(myRow, "A")
Sheets("<1 YR Not PTO").Cells(myCopyRow, "B") = Sheets("On PTO").Cells(myRow, "AC")
lastRow = Sheets("<1 YR Not PTO").Cells(Rows.Count, 1).End(xlDown).Row
myCopyRow = myCopyRow + 2
Sheets("On PTO").Cells(myRow, "A:Z").ClearContents
End If
Next myRow

Application.ScreenUpdating = True

End Sub

 

[Yongle]

As for the clear contents I'm receiving a run error

Try

Sheets("On PTO").Cells(myRow, 1).Resize(,26).ClearContents

To retain formulas

Dim cel As Range
For Each cel In Sheets("On PTO").Cells(myRow, 1).Resize(, 26)
    If Not cel.HasFormula Then cel.ClearContents
Next

 

[Yongle]

Try replacing

Sheets("<1 YR Not PTO").Cells(myCopyRow, "A") = Sheets("On PTO").Cells(myRow, "A")
Sheets("<1 YR Not PTO").Cells(myCopyRow, "B") = Sheets("On PTO").Cells(myRow, "AC")

with

myCopyRow = Sheets("<1 YR Not PTO").Cells(Rows.Count, "A").End(xlUp).Row + 1
If myCopyRow < 5 Then myCopyRow = 5
Sheets("<1 YR Not PTO").Cells(myCopyRow, "A").Resize(, 2) = Sheets("On PTO").Cells(myRow, "A").Resize(, 2)

You may need to add further check if A5 can be empty when B5 is not etc

If merged cells are causing VBA problems then find a way to get rid of your merged cells
- find another way to get the required look!

 

[DW09460]

Thank you Yongle for your assistance. I was able to tweak the code a bit and got it to work just the way I needed it. No issues with the merged cells A5, B5. However I did run into an issue with the clearcontents code. I get a run-time err "We can't do that to a merged cell". Would you happen to know a work around?

 

[Yongle]

Merged cells cause lots of issues like this (especially frustrating when users get creative with shared files containing VBA)

Test this on a copy of your workbook

    For Each cel In Sheets("On PTO").Cells(myRow, 1).Resize(, 26)
        On Error Resume Next
            If Not cel.HasFormula Then cel.ClearContents
            If Not cel.MergeArea(1, 1).HasFormula Then cel.MergeArea.ClearContents
        On Error GoTo 0
    Next

 

[DW09460]

Awesome, thank you so very much for your time in helping me with this Yongle. Plugged in the updated code and voila, there it isn't. No more run time err and it cleared all the cells. I'm still new to VBA but I'm learning something new every day thanks to people like you taking the time to help.

 

[Yongle]

glad it all worked out
thanks for the feedback