VBA- delete rows between two strings multiple times

[tzav]

Hi,
I need to delete rows between the words "Description" and "Transportation" every time they appear in column A, including deleting the rows those words appear in.
For example:
row 1-Description
row 2
row 3-Transportation
row 4
row 5-Description
row 6
row 7
row 8
row 9- Transportation
etc...
In this example, the result needs to be that only row 4 (and the ones after row 9) are still in the sheet.
I found a code but it has 2 problems:
1. It only deletes the first Description-Transportation couple (meaning rows 5-9 are still there).
2. The rows with those words stay on the sheet.

Thanks a lot!

PS I don't have to use this specific code, it just looked like it could help.



Sub Macro3()

Sub HideDeleteDT()

Const cSheet As Variant = "Sheet1"
Const cStr1 As String = "Description"
Const cStr2 As String = "Transportation"
Const cCol As Variant = "A"

Dim Find1 As Range
Dim Find2 As Range
Dim LCell As Range

With ThisWorkbook.Worksheets(cSheet)

With .Columns(cCol)
Set LCell = .Cells(.Cells.Count)
Set Find1 = .Find(cStr1, LCell, xlValues, xlWhole, xlByColumns)
End With
If Not Find1 Is Nothing Then
Set Find2 = .Range(Find1.Offset(1), LCell).Find(cStr2, LCell)
If Not Find2 Is Nothing Then
If Find1.Row + 1 < Find2.Row Then

If cDel Then
.Rows(Find1.Row + 1 & ":" & Find2.Row - 1).Delete
Else
.Rows.Hidden = False
.Rows(Find1.Row + 1 & ":" & Find2.Row - 1).Hidden = True
End If
End If
End If
End If
End With

End Sub

 

[Anthony47]

I need to delete rows between the words "Description" and "Transportation" every time they appear in column A, including deleting the rows those words appear in.

Try this macro:

Sub DelBlocks()
Dim TraBeg As Long, I As Long
'
Sheets("Sheet1").Select             '<<< Your worksheet
'
For I = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
    If InStr(1, Cells(I, 1).Value, "Transportation", vbTextCompare) = 1 Then TraBeg = I
    If InStr(1, Cells(I, 1).Value, "Description", vbTextCompare) = 1 And TraBeg > 0 Then
        Range(Cells(I, 1), Cells(TraBeg, 1)).EntireRow.Delete
        TraBeg = 0
    End If
Next I
End Sub

Edit the line marked <<< to point to your worksheet
Beware that it "deletes" the lines, whereas your code only hides them

Try...

 

[Peter_SSs]

Especially if your data is large and and the Description/Transportation pairs might be few, you could target them more directly, as you appear to have attempted, like this.
I have assumed that those words do appear in matched pairs throughout the data.

Sub DeleteBetween()
  Dim rDesc As Range
  
  With Sheets("Sheet1")
    Set rDesc = .Columns("A").Find(What:="Description", After:=.Cells(Rows.Count, 1), LookAt:=xlWhole, MatchCase:=False)
    If Not rDesc Is Nothing Then
      Do
        .Range(rDesc, .Columns("A").Find(What:="Transportation", LookAt:=xlWhole, MatchCase:=False)).EntireRow.Delete
        Set rDesc = .Columns("A").Find(What:="Description", After:=.Cells(Rows.Count, 1), LookAt:=xlWhole, MatchCase:=False)
      Loop Until rDesc Is Nothing
    End If
  End With
End Sub