The below assumes if B is blank the row should be deleted & that the last row with data in Column B is always the last row of the last template.
Without seeing the Formulae in place and/or a complete sheet with all templates in place it's hard to make any concrete assertions... as you've discovered the less info you provide the less likely you are to get an answer.
Public Sub CleanTemplate()
Dim ws As Worksheet
Dim lngLastRow As Long, lngRowi As Long, lngSubRowi As Long
Dim xlCalc As XlCalculation
On Error GoTo Handler
With Application
xlCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
Set ws = Sheets("Sheet1")
lngLastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row
For lngRowi = lngLastRow To 1 Step -72
If Application.CountBlank(ws.Range(Cells(lngRowi - 48, "B"), Cells(lngRowi - 18, "B"))) < 31 Then
For lngSubRowi = lngRowi - 18 To lngRowi - 48 Step -1
If ws.Cells(lngSubRowi, "B") = "" Then ws.Rows(lngSubRowi).EntireRow.Delete
Next lngSubRowi
Else
ws.Rows(lngRowi - 71 & ":" & lngRowi).EntireRow.Delete
End If
Next lngRowi
ExitPoint:
Set ws = Nothing
With Application
xlCalc = .Calculation
.Calculation = xlCalc
.EnableEvents = True
.ScreenUpdating = True
End With
Exit Sub
Handler:
MsgBox "Error Has Occurred" & vbLf & vbLf & _
"Error Number: " & Err.Number & vbLf & vbLf & _
"Error Desc.: " & Err.Description, _
vbCritical, _
"Fatal Error"
Resume ExitPoint
End Sub
Change the text in red to reflect the name of the sheet containing the templates.
Bookmarks