[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 127
  • Last Modified:

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
0
allanlorriman
Asked:
allanlorriman
  • 5
  • 3
  • 2
  • +1
3 Solutions
 
Martin LissRetired ProgrammerCommented:
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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
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 LissRetired ProgrammerCommented:
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
 
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

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 5
  • 3
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now