VBA keep every 6th row

[urimagic]

Hi friends,

please would someone help me with a code to keep every 5th row, starting from row 1?..This list grows by the week and will most certainly reach the maximum rows of the sheet eventually..Thank you all kindly..

My Groups.xlsm
	A	B
1	Kuilsriver Goods And Services💲
2	Your contribution points	0
3	Update time
4	Aug 17, 2023 5:56:52pm
5	Aug 17, 2023 5:56:52pm
6	Table View - * Buy * Sell * Ads
7	Your contribution points	0
8	Update time
9	Aug 17, 2023 5:56:13pm
10	Aug 17, 2023 5:56:13pm
11	Stellenbosh Ads, Buy & Sell
12	Your contribution points	0
13	Update time
14	Aug 17, 2023 5:56:10pm
15	Aug 17, 2023 5:56:10pm
16	Constantia/Tokai/Bishops Court/Sweet Valley/Steenberg/Parel Valei Ads Exec
17	Your contribution points	0
18	Update time
19	Aug 17, 2023 5:55:11pm
20	Aug 17, 2023 5:55:11pm
21	Pinelands Notice Board
22	Your contribution points	0
23	Update time
24	Aug 17, 2023 5:54:50pm
25	Aug 17, 2023 5:54:50pm
26	Rondebosch Advertising
Sheet1

 

[RobP]

Hi,

maybe this will get you where you want. Note the rows will be deleted from bottom up, and therefore you will be left with just a list of rows you wanted to keep at the top of the page.
ie. It does not leave the rows in between blank - it removes them completely.

If you wanted to just "clear" the rows, use the second piece of code instead, as this will leave your untouched rows where they are.

(and anything in Col C across the columns will also be removed)
cheers
Rob

Sub delete_rows()

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For x = lastrow To 1 Step -1

If x Mod 5 <> 1 Then
    Rows(x).EntireRow.Delete
End If

Next x

End Sub

To Clear row only (not delete)

Sub delete_rows()

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For x = lastrow To 1 Step -1

If x Mod 5 <> 1 Then
    Rows(x).EntireRow.Clear
End If

Next x

End Sub

 

[urimagic]

Hi,

maybe this will get you where you want. Note the rows will be deleted from bottom up, and therefore you will be left with just a list of rows you wanted to keep at the top of the page.
ie. It does not leave the rows in between blank - it removes them completely.

If you wanted to just "clear" the rows, use the second piece of code instead, as this will leave your untouched rows where they are.

(and anything in Col C across the columns will also be removed)
cheers
Rob

Sub delete_rows()

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For x = lastrow To 1 Step -1

If x Mod 5 <> 1 Then
    Rows(x).EntireRow.Delete
End If

Next x

End Sub

To Clear row only (not delete)

Sub delete_rows()

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For x = lastrow To 1 Step -1

If x Mod 5 <> 1 Then
    Rows(x).EntireRow.Clear
End If

Next x

End Sub

Hi RobP,

Thank you very much. Your code works just great, although I have come to realize something, which is that for some reason the report adds a row at some point in the report, obviiously causing problems. So, I'm a bit stumped now as how we can do this....Was wondering, could the code be altered instead to delete all rows which do not contain bold text?..This will solve the issue?..please, if you don't mind...

My Groups.xlsm
	A	B
786	Cape Town Business
787	Your contribution points	0
788	Update time
789	Aug 01, 2023 7:31:03pm
790	Aug 01, 2023 7:31:03pm
791	Cape town buying and selling group
792	Your contribution points	31
793	How you earned contribution points
794	Contribution points earned from interactions	31
795	Update time
796	Aug 17, 2023 10:39:10pm
797	Aug 01, 2023 7:30:59pm
798	BUYING AND SELLING IN CAPETOWN
799	Your contribution points	0
800	Update time
801	Aug 01, 2023 7:30:32pm
802	Aug 01, 2023 7:30:32pm
803	Markets/Vendors Cape Town
Sheet1

 

[Candyman8019]

You could try something like this:

Sub delete_rows()

LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For x = LastRow To 1 Step -1

If Range("A" & x).Font.Bold = False Then
    Rows(x).EntireRow.Delete
End If

Next x

End Sub

 

[Joe4]

If you have a lot of lines of data, I would recommend suppressing screen updating until the end.
This will speed up your code a bit, i.e.

Sub delete_rows()

Application.ScreenUpdating = False

LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For x = LastRow To 1 Step -1

If Range("A" & x).Font.Bold = False Then
    Rows(x).EntireRow.Delete
End If

Next x

Application.ScreenUpdating = True

End Sub

 

[urimagic]

You could try something like this:

Sub delete_rows()

LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For x = LastRow To 1 Step -1

If Range("A" & x).Font.Bold = False Then
    Rows(x).EntireRow.Delete
End If

Next x

End Sub

Hi Candyman8019,

Code is perfect!!..I do appreciate, thank you very much!

 

[urimagic]

If you have a lot of lines of data, I would recommend suppressing screen updating until the end.
This will speed up your code a bit, i.e.

Sub delete_rows()

Application.ScreenUpdating = False

LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For x = LastRow To 1 Step -1

If Range("A" & x).Font.Bold = False Then
    Rows(x).EntireRow.Delete
End If

Next x

Application.ScreenUpdating = True

End Sub

Hi, Joe4,

Thanks, I have added your piece as well...much appreciated!..Thanks.