What is the best way to erase lines in a table that are hidden

[Romano_odK]

Good morning,
At first I searched through the internet for VAB coding to erase lines that are hidden by a filter. But the most of what I found are to complex for me to change or do not work properly. I simply only want to erase the lines that are hidden in a table. Who can advice me in this matter?
Thank you for you time.

Book1
	A	B	C	D	E	F	G	H	I	J	K
1	Artikelcode	Omschrijving	Kostprijs	Ontvgstdatum	Aantal	Waarde	Vrrdrek	Std_locatie	Magazijn	Locatie	Voorraad
2	100000	Vito Glaserfix 111 6x2 mm wit - 10x25 m	2,00	11/07/2023	96	10	3901	P02B	1	P02B	8,0
3	100001	Vito Glaserfix 111 6x2 mm zwart - 10x25 m	2,00	18/04/2023	96	10	3901	P04B	1	P04B	8,0
4	100002	Vito Glaserfix 111 6x3 mm wit - 10x25 m	2,00	11/07/2023	96	10	3901	P02B	1	P02B	8,0
5	100003	Vito Glaserfix 111 6x3 mm zwart - 10x25 m	2,00	25/04/2023	96	10	3901	P04B	1	P04B	8,0
6	100004	Vito Glaserfix 111 6x4 mm wit - 10x25 m	2,00	06/09/2023	96	10	3901	P02B	1	P02B	8,0
7	100004	Vito Glaserfix 111 6x4 mm wit - 10x25 m	2,00	06/09/2023	96	10	3901	P02B	1	P02C	8,0
8	100005	Vito Glaserfix 111 6x4 mm zwart - 10x25 m	2,00	31/03/2021	96	10	3901	AAP	1	P04B	8,0
9	100006	Vito Glaserfix 111 9x2 mm wit - 10x25 m	2,00	13/09/2023	60	10	3901	P01B	1	P01B	8,0
10	100007	Vito Glaserfix 111 9x2 mm zwart - 10x25 m	2,00	16/08/2023	60	10	3901	P03B	1	P03B	8,0
11	100008	Vito Glaserfix 111 9x3 mm wit - 10x25 m	2,00	16/08/2023	200	10	3901	Q07A	1	Q07A	8,0
12	100008	Vito Glaserfix 111 9x3 mm wit - 10x25 m	2,00	16/08/2023	200	10	3901	Q07A	1	Q09B	8,0
14	100009	Vito Glaserfix 111 9x3 mm zwart - 10x25 m	2,00	01/08/2023	200	10	3901	Q07A	1	Q07B	8,0
16	100009	Vito Glaserfix 111 9x3 mm zwart - 10x25 m	2,00	01/08/2023	200	10	3901	Q07A	1	Q07A	8,0
17	100010	Vito Glaserfix 111 9x4 mm wit - 10x25 m	2,00	27/06/2023	200	10	3901	Q08A	1	Q07B	8,0
18	100010	Vito Glaserfix 111 9x4 mm wit - 10x25 m	2,00	27/06/2023	200	10	3901	Q08A	1	Q08A	8,0
19	100011	Vito Glaserfix 111 9x4 mm zwart - 10x25 m	2,00	04/04/2023	200	10	3901	Q07A	1	Q07A	8,0
20	100012	Vito Glaserfix 111 9x5 mm wit - 10x10 m	2,00	23/08/2023	60	10	3901	P01B	1	P01B	8,0
21	100013	Vito Glaserfix 111 9x5 mm zwart - 10x10 m	2,00	15/06/2021	60	10	3901	P03B	1	P03B	8,0
22	100014	Vito Glaserfix 111 9x6 mm wit - 10x10 m	2,00	06/10/2020	60	10	3901	P01B	1	P01B	8,0
23	100015	Vito Glaserfix 111 9x6 mm zwart - 10x10 m	2,00	18/04/2023	60	10	3901	P03B	1	P03B	8,0
24	101000	Vito Glaserfix 111 9x1 mm wit - 33 m	2,00	23/05/2023	2448	10	3901	O01A	1	O01A	8,0
25	101000	Vito Glaserfix 111 9x1 mm wit - 33 m	2,00	23/05/2023	2448	10	3901	O01A	1	O01C	8,0
26	101001	Vito Glaserfix 111 9x1 mm zwart - 33 m	2,00	11/07/2023	2473	10	3901	O01A	1	O01A	8,0
27	101001	Vito Glaserfix 111 9x1 mm zwart - 33 m	2,00	11/07/2023	2473	10	3901	O01A	1	O01B	8,0
28
Sheet1

 

[Akuini]

Good morning,
This is very fast but also erases my table and does not delete the lines. Fast yes, but not as functional as I would like it to be. Thank you for our time.

If the table is an actual table (not just a range) then try this (change "Table1" to suit):

Sub Romano_odK_2()
Dim r As Range, q As Range, a As Range, b As Range
Dim tbl As ListObject

Set tbl = ActiveSheet.ListObjects("Table1")

Set q = tbl.DataBodyRange.Columns(1)
Set r = q.SpecialCells(xlCellTypeVisible)

tbl.AutoFilter.ShowAllData

r.EntireRow.Hidden = True
q.SpecialCells(xlCellTypeVisible).Rows.ClearContents
q.EntireRow.Hidden = False

tbl.Range.Sort Key1:=tbl.Range.Cells(1), Order1:=xlAscending, Header:=xlYes

'first blank row
Set a = tbl.Range.Cells(1).End(xlDown).Offset(1)
'last row
Set b = a.End(xlDown)

If Not Intersect(b, tbl.DataBodyRange) Is Nothing Then
    Range(a, b).Rows.Delete xlUp
Else 'if there's only 1 blank row
    a.Rows.Delete xlUp
End If

End Sub

 

[Romano_odK]

If the table is an actual table (not just a range) then try this (change "Table1" to suit):

Sub Romano_odK_2()
Dim r As Range, q As Range, a As Range, b As Range
Dim tbl As ListObject

Set tbl = ActiveSheet.ListObjects("Table1")

Set q = tbl.DataBodyRange.Columns(1)
Set r = q.SpecialCells(xlCellTypeVisible)

tbl.AutoFilter.ShowAllData

r.EntireRow.Hidden = True
q.SpecialCells(xlCellTypeVisible).Rows.ClearContents
q.EntireRow.Hidden = False

tbl.Range.Sort Key1:=tbl.Range.Cells(1), Order1:=xlAscending, Header:=xlYes

'first blank row
Set a = tbl.Range.Cells(1).End(xlDown).Offset(1)
'last row
Set b = a.End(xlDown)

If Not Intersect(b, tbl.DataBodyRange) Is Nothing Then
    Range(a, b).Rows.Delete xlUp
Else 'if there's only 1 blank row
    a.Rows.Delete xlUp
End If

End Sub

This is blazing fast and works great. Thank you. Have a great weekend.

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.