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

 

[HaHoBe]

Hi VeKa27,

change codelines at the end to

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

Ciao,
Holger

 

[VeKa27]

Hi Holger,

Great! It works as well now. I'm gonna implement this code in my original document.
In this document i have also the same sheet but there are the stages on Line5, 11, 17 (instead of 10 lines it is 6 lines)
To make your code work for that sheet, do i only have to change the step from 10 to 6 ?
(i am very greatfull for your support)

 

[Legacy 143009]

Here is a working version of my code starting from 5th row and leaving only 6 rows.

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

  For i = 5 To lRow
    If Left(Cells(i, 1).Value, 5) = "Stage" Then
      If Left(Cells(i + 6, 1).Value, 5) <> "Stage" Then
        Cells(i + 6, 1).EntireRow.Delete
        If Cells(i + 6, 1).Value <> "" Then
          i = i - 1
        End If
      End If
    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,

as there are some hard coded distances regarding the first posting maybe try this

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

Const cstrSEARCH    As String = "Stage"
Const clngDist      As Long = 6
Const clngStart     As Long = 5

For lngRow = clngStart 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.EntireRow.Delete
  Set rngDel = Nothing
End If

For lngRow = clngStart To Cells(Rows.Count, "A").End(xlUp).Row Step clngDist
  Range(Cells(lngRow + 1, "A"), Cells(lngRow + clngDist - 1, "A")).EntireRow.ClearContents
Next lngRow
End Sub

Please note that the code will not work correctly if there are less rows between the searched items.

Holger

 

[HaHoBe]

Hi VeKa27,

here is a different approach which would also insert any missing lines between the searched items (and of course delete the ones that had been added):

Public Sub MrE_1222736_161480C()
' https://www.mrexcel.com/board/threads/vba-search-specific-lines-and-delete-them.1222736/
' Code works on ActiveSheet
Dim lngStart        As Long
Dim var             As Variant

Const cstrSEARCH    As String = "Stage"
Const clngDist      As Long = 6
Const clngStart     As Long = 5
  
lngStart = clngStart + 1
var = lngStart

Application.ScreenUpdating = False
Do Until Cells(lngStart, "A").Value = ""
  var = Application.Match(cstrSEARCH & "*", Range(Cells(lngStart, "A"), Cells(Rows.Count, "A").End(xlUp)), 0)
  If IsNumeric(var) Then
    If lngStart + var - 1 > lngStart + clngDist Then
      Range(Cells(lngStart + clngDist - 1, "A"), Cells(lngStart + var - 2, "A")).EntireRow.Delete xlShiftUp
      Range(Cells(lngStart, "A"), Cells(lngStart + clngDist - 2, "A")).EntireRow.ClearContents
    ElseIf lngStart + var < lngStart + clngDist Then
      Cells(lngStart + var - 1, "A").Resize(clngDist - var, 1).EntireRow.Insert xlShiftDown
      Range(Cells(lngStart, "A"), Cells(lngStart + clngDist - 2, "A")).EntireRow.ClearContents
    Else
      Range(Cells(lngStart, "A"), Cells(lngStart + clngDist - 2, "A")).EntireRow.ClearContents
    End If
    lngStart = lngStart + clngDist
  Else
    Range(Cells(lngStart, "A"), Cells(Rows.Count, "A").End(xlUp)).EntireRow.ClearContents
    Exit Do
  End If
Loop
Application.ScreenUpdating = True
End Sub

Ciao,
Holger

 

[VeKa27]

@Flashbond: Thx for you code but is it also possible to keep the data in the first line under each stage line?

 

[Legacy 143009]

It should keep the first line after "Stage "

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

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

 

[VeKa27]

@Holger: Your last code does not do anything anymore?

@Flashbond: Code works but if there are mor then 1 extra line, the code deletes the lines only one by one (i have to repeat the code untill all extra lines are gone)

 

[Legacy 143009]

It deletes every extra line when I run it.
Let say you have Stage at line 5 and you have data upto row 12. It will delete row 12 and 11 until the next Stage reaches to row 11.

 

[VeKa27]

@Flashbond: If i run the code, it only deletes row12. If i run it again, it deletes row11.
The same thing happens with the other stages, only one by one and have to repeat the code