Deleting Variable Amount of Rows

[alexdelwar]

Hello,

Would truly appreciate if anyone can help me with this problem.

Original data:


Any help would be appreciated.

 

[alexdelwar]

Sorry. Messed up attaching photos. First time posting something...

Hello,

Would truly appreciate if anyone can help me with this problem.

Original data:

X	1321
	42145 <colgroup><col width="64"></colgroup><tbody> </tbody>
	123412 <colgroup><col width="64"></colgroup><tbody> </tbody>
Y	31231 <colgroup><col width="64"></colgroup><tbody> </tbody>
	4 <colgroup><col width="64"></colgroup><tbody> </tbody>
	32131 <colgroup><col width="64"></colgroup><tbody> </tbody>
	432 <colgroup><col width="64"></colgroup><tbody> </tbody>
X <colgroup><col width="64"></colgroup><tbody> </tbody>	123 <colgroup><col width="64"></colgroup><tbody> </tbody>
	123 <colgroup><col width="64"></colgroup><tbody> </tbody>
Y <colgroup><col width="64"></colgroup><tbody> </tbody>	123 <colgroup><col width="64"></colgroup><tbody> </tbody>
	123 <colgroup><col width="64"></colgroup><tbody> </tbody>
X <colgroup><col width="64"></colgroup><tbody> </tbody>	4 <colgroup><col width="64"></colgroup><tbody> </tbody>
	123 <colgroup><col width="64"></colgroup><tbody> </tbody>
X <colgroup><col width="64"></colgroup><tbody> </tbody>	1 <colgroup><col width="64"></colgroup><tbody> </tbody>
	241 <colgroup><col width="64"></colgroup><tbody> </tbody>
	23 <colgroup><col width="64"></colgroup><tbody> </tbody>
	124 <colgroup><col width="64"></colgroup><tbody> </tbody>

<tbody>
</tbody>

I need to delete rows with the letter Y in column A and any rows below until the next letter appears in column A. It doesn't matter what the actual next letter is. I'm looking for vba code as i have thousands of rows.

Result:

X	1321 <colgroup><col width="64"></colgroup><tbody> </tbody>
	42145 <colgroup><col width="64"></colgroup><tbody> </tbody>
	123412 <colgroup><col width="64"></colgroup><tbody> </tbody>
X <colgroup><col width="64"></colgroup><tbody> </tbody>	123 <colgroup><col width="64"></colgroup><tbody> </tbody>
	123 <colgroup><col width="64"></colgroup><tbody> </tbody>
X <colgroup><col width="64"></colgroup><tbody> </tbody>	4 <colgroup><col width="64"></colgroup><tbody> </tbody>
	123 <colgroup><col width="64"></colgroup><tbody> </tbody>
X <colgroup><col width="64"></colgroup><tbody> </tbody>	1 <colgroup><col width="64"></colgroup><tbody> </tbody>
	241 <colgroup><col width="64"></colgroup><tbody> </tbody>
	23 <colgroup><col width="64"></colgroup><tbody> </tbody>
	124 <colgroup><col width="64"></colgroup><tbody> </tbody>

<tbody>
</tbody>

Any help would be appreciated.

 

[crazydragon84]

?????

 

[MARK858]

Slow method...

Sub DeleteY()
    Dim i As Long, lr As Long
    
    Application.ScreenUpdating = False
    
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    
    For i = lr To 1 Step -1
        If UCase(Cells(i, "A")) = "Y" Then Range(Cells(i, "A"), Cells(i, "A").End(xlDown).Offset(-1)).EntireRow.Delete
    Next
    
    Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

Fast method, though you may not notice the difference unless you have tens or hundreds of thousands of rows.

Sub Del_Y_and_Following_Blanks()
  Dim a, b
  Dim nc As Long, i As Long, k As Long

  nc = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious, SearchFormat:=False).Column + 1
  a = Range("A1", Range("B" & Rows.Count).End(xlUp).Offset(1)).Value
  a(UBound(a), 1) = "@"
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) = "Y" Then
      b(i, 1) = 1
      k = k + 1
      Do Until a(i + 1, 1) <> ""
        i = i + 1
        k = k + 1
        b(i, 1) = 1
      Loop
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A1").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub

 

[Peter_SSs]

Slow method...

Mark, I don't know if it is possible with the OP's data, but if the following was possible, your code would delete rows that it shouldn't.

Book1
	A	B
1	Y	1
2		1
3	Y	1
4	X	1
5	X	1
6	X	1
7	X	1
Sheet2

 

[MARK858]

Mark, I don't know if it is possible with the OP's data, but if the following was possible, your code would delete rows that it shouldn't.

I know but I based my reply on the data posted

 

[Peter_SSs]

I know but I based my reply on the data posted

Fair enough. I interpreted the any in the OP's comments to mean the possibility of none. At least the issue has been raised for the OP or other readers.

.. delete rows with the letter Y in column A and any rows below until the next letter appears in column A.

 

[alexdelwar]

Thanks Peter!!

Sub Del_Y_and_Following_Blanks() worked like a charm!

 

[Peter_SSs]

Thanks Peter!!

Sub Del_Y_and_Following_Blanks() worked like a charm!

Great! Thanks for letting us know.