VBA search specific lines and delete them

[VeKa27]

Hi you all. I need some help in this problem i have..
Imagine a clean excel sheet. In cell A10 i have Text "Stage 1". In cell A20 i have Text "Stage 2". In cell A30 i have Text "Stage 3".
Under every Stage i put some data in the 9 free lines.
Each day i make a reset to delete all data in the 9 free lines to start the day clean.
But now comes the problem..
Sometimes i insert new lines because i had not enough lines. If i reset the next day, i delete the inserted lines again because i only want 9 free lines under every Stage.
Now i'm searching to insert a code to search the cells with the Stages and delete the lines under every stage exept the 9 first ones. I cannot delete the Stages lines themselves.
Below the Stages there is a Table that i also cannot delete or touch.
It is just a question how to delete the new inserted lines and the data in the 9 lines under every Stage.
Thanks a lot to help me with this one

 

[Legacy 143009]

Something like this?

Sub myFunction()
  Dim lRow As Integer
  lRow = Cells(Rows.Count, 1).End(xlUp).Row

  For i = lRow To 1 Step -1
    If Left(Cells(i, 1).Value, 5) <> "Stage" Then
      Cells(i, 1).EntireRow.Delete
    Else
      For j = 1 To 9
        Cells(i, 1).EntireRow.Insert
      Next
    End If
  Next
End Sub

 

[VeKa27]

Hi Flashbond,
Thx for your input. In your code we delete also the 9 free lines and that may not happen because there is also soms conditional formatting in those lines..
(i will answer back tomorrow because i got to leave now)

 

[Legacy 143009]

Sub myFunction()
  Dim lRow As Integer
  lRow = Cells(Rows.Count, 1).End(xlUp).Row

  For i = 10 To lRow
    If Left(Cells(i, 1).Value, 5) = "Stage" Then
      Do While Left(Cells(i+10, 1).Value, 5) <> "Stage"
        Cells(i+10, 1).EntireRow.Delete
      Loop
    Else
      Range(Cells(i, 1), Cells(i, 3)).ClearContents 'Let say you have 3 columns of data
    End If
  Next
End Sub

Something similar to this must do the work. I can not say anything about the tables without seeing the layout.

 

[Legacy 143009]

In Stage 3, Do While will loop forever Let me think a bit more about it

 

[Legacy 143009]

Sub myFunction()
  Dim lRow As Integer
  lRow = Cells(Rows.Count, 1).End(xlUp).Row

  For i = 10 To lRow
    If Left(Cells(i, 1).Value, 5) = "Stage" Then
      Do While Left(Cells(i+10, 1).Value, 5) <> "Stage" Or Cells(i+10, 1).Value <> ""
        Cells(i+10, 1).EntireRow.Delete
      Loop
    Else
      Range(Cells(i, 1), Cells(i, 3)).ClearContents 'Let say you have 3 columns of data
    End If
  Next
End Sub

 

[HaHoBe]

Hi VeKa27,

maybe

Public Sub MrE_1222736_1614512_Vers1()
' https://www.mrexcel.com/board/threads/vba-search-specific-lines-and-delete-them.1222736/
' Created: 20221121
' By:      HaHoBe
Dim lngRow As Long
Dim lngBetween As Long
Dim rngDel As Range

Const cstrSEARCH As String = "Stage"
Const clngDist As Long = 10

For lngRow = 10 To Cells(Rows.Count, "A").End(xlUp).Row
  If Left(Cells(lngRow, "A").Value, Len(cstrSEARCH)) = cstrSEARCH Then
    lngBetween = 0
  End If
  lngBetween = lngBetween + 1
  If lngBetween > clngDist Then
    If rngDel Is Nothing Then
      Set rngDel = Cells(lngRow, "A")
    Else
      Set rngDel = Union(rngDel, Cells(lngRow, "A"))
    End If
  End If
Next lngRow

If Not rngDel Is Nothing Then
  rngDel.Delete
  Set rngDel = Nothing
End If

For lngRow = 11 To Cells(Rows.Count, "A").End(xlUp).Row Step 10
  Range(Cells(lngRow, "A"), Cells(lngRow + 8, "A")).ClearContents
Next lngRow
End Sub

Ciao,
Holger

 

[VeKa27]

Hi, sorry for late answer..

@Flashbond, the code (both) stays in the loop so i have to stop Excel and re-open..

@Holger, the code seems to work but it is only deleting the rows from columnA and not the whole row. Is it possible to delete the whole extra rows because there can also be data in col B,C,D,...

Thanks to re-evaluate

 

[HaHoBe]

Hi VeKa27,

change code at the end to read

If Not rngDel Is Nothing Then
  rngDel.EntireRow.Delete
  Set rngDel = Nothing
End If

For lngRow = 11 To Cells(Rows.Count, "A").End(xlUp).Row Step 10
  Range(Cells(lngRow, "A"), Cells(lngRow + 8, "A")).EntireRow.ClearContents
Next lngRow

Ciao,
Holger

 

[VeKa27]

Hi Holger,

That seems to works fine! (happy)
Last request: is it possible to keep the data in the first line under each stage? I see now that it will be better for me to keep this data in those lines..