Delete specific rows

[daleonos]

Hi everyone. I really need help with this. I've tried searching the answer first to this question of mine, but to no avail. I'm quite puzzled.

I'd like to have specific rows deleted from an Excel file which contains more than 50k rows of data..

Each person contains 17 rows as you can see in the sample image.

For example, I'd like to retain the ones I've highlighted in green and delete the rest in red. How can I do that? Is there a specific function in Excel or should I be using some VBA codes? I'm sorry I'm just a beginner in Excel and I'd really love to learn.

Here's the output that I'm looking for:

John Smith

John Smith Company

(917) 278-9826

john@johnsmith.com

Jane Smith

Jane Smith Inc.

(212) 566-5889

jane@jsmithinc.com

<tbody>
</tbody>

So, basically I'd like to be able to delete rows 3, 4, 5, 6, 7, 8, 10, 12, 13, 14, 15, 16, 17 and retain rows 1, 2, 9, 11.
There seems to be a pattern.
For the next person delete rows 20, 21, 22, 23, 24, 25, 27, 29, 30, 31, 32, 33, 34 and retain rows 18, 19, 26, 28.
And so on and so forth for the next rows of data til row 50,000+.

Here's the image for further reference:

Please let me know if this makes sense.

I'll be on a lookout to your replies guys. I'd really appreciate it.

Thanks a lot in advance!

 

[JackDanIce]

Welcome to the board. Try running this macro:

Sub DelRows()

Dim rng As Range, x As Long, y As Long

Application.ScreenUpdating = False

Set rng = Range("A1")

For x = 1 To Range("A" & Rows.Count).End(xlUp).Row Step 17
    For y = 0 To 16
        Select Case y
            Case 0, 1, 8, 10
               Set rng = Union(rng, Range("A" & x + y))
            Case Else
        End Select
    Next y
Next x

rng.EntireRow.Delete

Application.ScreenUpdating = True

End Sub

Alternatively, for range B1:B17, enter TRUE or FALSE depending on whether you want to keep it or not. Then copy this range and paste to B18, then to B35 etc, until the last value. Filter column B for the FALSE values and delete these rows.

 

[Rick Rothstein]

Here is another macro for you to try...

Sub SaveFourLinesPerRecord()
  Dim X As Long, LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Application.ScreenUpdating = False
  For X = 0 To LastRow - 1 Step 17
    Range("A3:A8,A10,A12:A17").Offset(X).Clear
  Next
  Range("A1:A" & LastRow).SpecialCells(xlBlanks).EntireRow.Delete
  Application.ScreenUpdating = True
End Sub