I have a script that deletes rows based on a status cell in each row, then subsequently inserts new rows (same row count as those deleted) to the second to last row in the sheet. I am running into a problem when I try to copy the formulas down. As written, it copies everything (including inputs). I would like it to copy formulas only.
Background: Formulas go to row 1000 to keep the file size small. As soon as I delete a row, the formulas using those cells change from say A10:A1000 to A10:A999. Eventually the file will get too small, so I want to insert rows to get the formulas to always extend down to row 1000.
Code:
Sub Delete_range_ws2()
Dim i As Long
Dim TexttoFind As String
Dim ws2 As Worksheet
Set ws2 = Sheets("2. and 6. WD Input vs GL")
TexttoFind = "Ready to Delete" ' <-- Use a variable, this is easy to modify later
'Step 1: Find any row that has "Ready to Delete" and and delete the entir row.
For i = Range("CZ5000").End(xlUp).Row To 1 Step -1 'Find Last Row. NOTE, I put the range at 5x the 1000 row limit. I'm sure there is a better way, but I didn't have time to figure it out.
If ws2.Range("CZ" & i) = TexttoFind Then 'Look in last row for "Ready to Delete"
ws2.Rows(i).Delete 'If found, delete row
End If
Range("A3").Select 'Bring user's view back to top left corner of sheet
Next
Dim lrow As Integer
Dim m As Integer
Dim n As Integer
'Step 2: Now that we deleted rows, we need to add blank rows back into the sheet and copy formulas down
'Why? Trying to make sure formulas continue to row 1000
With ws2
lrow = Cells(Rows.Count, "A").End(xlUp).Row 'Now that rows have been deleted, find the new last row
m = Cells(Rows.Count, "A").End(xlUp).Row - 1 'Find Second to last row
n = 1000 - lrow 'Number of rows that were deleted
If lrow = 1000 Then 'If true, then the above logic didn't delete any rows.
Else
'If not True, then find the last row and insert the number of rows that were deleted
ws2.Rows(lrow & ":" & m + n).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'Now that rows were inserted, we need to copy down
'formulas all the way to the limit of row 1000
'This is not perfect, it just goes back up the rows and finds a row to copy
'formulas down. THis WILL NOT Copy text inputs
ws2.Rows(m - n).Copy
ws2.Rows(m - n & ":1000").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone
End If 'Ends the IF Statement
ws2.Range("A3").Select 'Bring user's view back to top left corner of sheet
End With 'Ends the With Statement
End Sub