excel delete rows

Hello Experts
I have an excel document of over 4000 rows of data in it, I have to keep every 8th row and delete the rest 1 - 7 rows.
What I mean here is, delete 1 - 7 rows and keep the 8th, and then remove another 7 rows  ie: 9-15 and keep the 16 th row and so on..
Is there any way I can automate this in excel? Going through manually would take all my time today..
Please advice?
Thanks
allanlorrimanAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
Try this macro.

Sub Keep8th()
Dim lngRow As Long

Application.ScreenUpdating = False

For lngRow = Sheets("Sheet1").UsedRange.Rows.Count To 1 Step -1
    If lngRow Mod 8 <> 0 Then
        Cells(lngRow, 1).EntireRow.Delete
    End If
Next

Application.ScreenUpdating = True
End Sub

Open in new window

0
Rgonzo1971Commented:
Hi,

pls try

Sub macro1()
LastRow = WorksheetFunction.MRound(Range("A" & Rows.Count).End(xlUp).Row, 8)
For Idx = LastRow To 8 Step -8
    Range("A" & Idx - 7 & ":A" & Idx - 1).EntireRow.Delete
Next
End Sub

Regards
0
krishnakrkcCommented:
Hi

Option Explicit

Sub kTest()
    
    Dim k, kk(), i As Long, n As Long
    Dim c As Long, Flg As Boolean, m As Long
    
    k = Range("a1").CurrentRegion.Value2
    
    Flg = True 'set False if no column header
    
    m = Abs(CLng(Flg))
    
    ReDim kk(1 To 1 + UBound(k, 1) \ 8, 1 To UBound(k, 2))
    
    For i = 1 + m To UBound(k, 1) 'assume the data has column header, if no, replace 2 with 1
        If (i - m) Mod 8 = 0 Then
            n = n + 1
            For c = 1 To UBound(k, 2)
                kk(n, c) = k(i, c)
            Next
        End If
    Next
    
    If n Then
        Worksheets.Add
        If Flg Then
            Range("a1").Resize(, UBound(kk, 2)).Value = Application.Index(k, 1, 0)
        End If
        Range("a1").Offset(m).Resize(n, UBound(kk, 2)).Value = kk
    End If
    
End Sub

Open in new window


Kris
0
Cloud Class® Course: CompTIA Cloud+

The CompTIA Cloud+ Basic training course will teach you about cloud concepts and models, data storage, networking, and network infrastructure.

allanlorrimanAuthor Commented:
thanks all for your input,

Kris, your script works when but instead of keeping the 8th row, its keeping the 9th one. This is because an additional header row.

If I change the change the script to

  ReDim kk(1 To 1 + UBound(k, 1) \ 9, 1 To UBound(k, 2))

It gives an error..

Please can you advice how can I go about the shifting the row to 9?

Thanks
0
krishnakrkcCommented:
It works fine here. Or am I missing anything ?

PFA.

Kris
Book1.xlsb
0
Martin LissOlder than dirtCommented:
Did you try mine?
0
allanlorrimanAuthor Commented:
Hi Kris
Please see the attached, you are obviously keeping the 9th row but that including the header I would need the 10th row as attached.
Please can you advice?

Hi Martin,
Yes, I did try but again, my bad, I probably not have explained it well. I hope you udnerstand now. Please find attached the highlighted lines I wanted to keep.
Book1.xlsb
0
krishnakrkcCommented:
Hi

Try this

Option Explicit

Sub kTest()
    
    Dim k, kk(), i As Long, n As Long
    Dim c As Long, Flg As Boolean, m As Long
    
    k = Range("a1").CurrentRegion.Value2
    
    Flg = True 'set False if no column header
    
    m = Abs(CLng(Flg))
    
    ReDim kk(1 To 1 + UBound(k, 1) \ 9, 1 To UBound(k, 2))
    
    For i = 1 + m To UBound(k, 1)
        If (i - m) Mod 9 = 0 Then
            n = n + 1
            For c = 1 To UBound(k, 2)
                kk(n, c) = k(i, c)
            Next
        End If
    Next
    
    If n Then
        Worksheets.Add
        If Flg Then
            Range("a1").Resize(, UBound(kk, 2)).Value = Application.Index(k, 1, 0)
        End If
        Range("a1").Offset(m).Resize(n, UBound(kk, 2)).Value = kk
    End If
    
End Sub

Open in new window


Kris
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
allanlorrimanAuthor Commented:
I am getting the following rows without a header row

a1      a2      a3      a4      a5      a6      a7      a8      a9      a10
a9      a2      a3      a4      a5      a6      a7      a8      a9      a10
a17      a2      a3      a4      a5      a6      a7      a8      a9      a10
a25      a2      a3      a4      a5      a6      a7      a8      a9      a10

And this with the header

a1      a2      a3      a4      a5      a6      a7      a8      a9      a10
a9      a2      a3      a4      a5      a6      a7      a8      a9      a10
a17      a2      a3      a4      a5      a6      a7      a8      a9      a10
a25      a2      a3      a4      a5      a6      a7      a8      a9      a10

Instead of

a9      a2      a3      a4      a5      a6      a7      a8      a9      a10
a18      a2      a3      a4      a5      a6      a7      a8      a9      a10
a27      a2      a3      a4      a5      a6      a7      a8      a9      a10
0
allanlorrimanAuthor Commented:
That is it Kris, this seems to have worked on the  test file. Thank you so much.

I will check on my document and I hope it works.

Regards
Allan
0
allanlorrimanAuthor Commented:
Thanks for your wonderful help Kris!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.