delete rows based on set of numbers (vba macro)

[excelNewbie22]

hi!
so i tried with watching videos in youtube, searching and testing for hours for several days, with no success
but i found a vba macro partly to my needs,
which is to delete ANY row without ANY or ALL the numbers i'll set (like 5 6 7 or more)
didn't manage to redefine the range (all rows in current sheet)
can you please help me out?

Sub DeleteRows()
' Defines variables
Dim Cell As Range, cRange As Range, LastRow As Long, x As Long


' Defines LastRow as the last row of data based on column A
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row


' Sets check range as A1 to the last row of A
Set cRange = Range("A1:A" & LastRow)

' For each cell in the check range, working from the bottom upwards
For x = cRange.Cells.Count To 1 Step -1
    With cRange.Cells(x)
        ' If the cell does not contain one of the listed values then...
        If .Value <> "5" And .Value <> "6" And .Value <> "7" Then
            ' Delete that row
            .EntireRow.Delete
        End If
    End With
' Check next cell, working upwards
Next x


End Sub

example:

567.xlsx
	A	B	C	D
6	1	1	2	7
7	1	1	2	8
8	1	1	3	2
9	1	1	3	3
10	1	1	3	4
11	1	1	3	5
12	1	1	3	6
13	1	1	3	7
14	1	1	3	8
15	1	1	4	2
16	1	1	4	3
17	1	1	4	4
18	1	1	4	5
19	1	1	4	6
20	1	1	4	7
21	1	1	4	8
22	1	1	5	2
23	1	1	5	3
24	1	1	5	4
25	1	1	5	5
26	1	1	5	6
27	1	1	5	8
28	1	1	6	2
29	1	1	6	3
30	1	1	6	4
31	1	1	6	5
32	1	1	6	6
33	1	1	6	7
34	1	1	6	8
35	1	1	7	2
567

 

[Siddharth Rout]

Deleting rows in a loop can be slow. Also keeping track of what numbers to delete. You may want to use Autofilter with Array to remove unwanted rows? Something like this?

Option Explicit

Sub Sample()
    Dim col As New Collection
    Dim itm As Variant
    Dim i As Long, j As Long, k As Long
    Dim lRow As Long
    Dim MyArray() As String
    Dim ws As Worksheet
    Dim IsInArray As Boolean
 
    '~~> Change this to the relevant Sheet
    Set ws = Sheet1
 
    '~~> Change the dimension as required.
    '~~> Any number other than these will be deleted
    Dim ExcludeArray(1 To 3) As Variant
    ExcludeArray(1) = 5
    ExcludeArray(2) = 6
    ExcludeArray(3) = 7
 
    With ws
        .AutoFilterMode = False
    
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
    
        '~~> Get a unique count of items in the column. Assuming first cell has Header
        For i = 2 To lRow
            On Error Resume Next
            col.Add .Cells(i, 1).Value2, CStr(.Cells(i, 1).Value2)
            On Error GoTo 0
        Next i
    
        k = col.Count
    
        '~~> Find how many numbers are there which needs to be deleted
        For Each itm In col
            For j = LBound(ExcludeArray) To UBound(ExcludeArray)
                If itm = ExcludeArray(j) Then
                    k = k - 1
                    Exit For
                End If
            Next j
        Next itm
            
        '~~> Store the numbers to be deleted in an array
        ReDim MyArray(1 To k)
        k = 1
    
        For Each itm In col
            On Error Resume Next
            IsInArray = Application.Match(itm, ExcludeArray, 0)
            On Error GoTo 0
    
            If IsInArray = False Then
                MyArray(k) = itm
                k = k + 1
            Else
                IsInArray = False
            End If
        Next itm
    
        '~~> Use Autofilter to delete the rows in 1 go
        With .Range("A1:A" & lRow)
            .AutoFilter Field:=1, Criteria1:=MyArray, Operator:=xlFilterValues
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With
    
       .AutoFilterMode = False
    End With
End Sub

 

[excelNewbie22]

thanks for helping
it give me an error

 

[Siddharth Rout]

thanks for helping
it give me an error

Did you change anything in the code as I have declared all variables.

 

[excelNewbie22]

only the sheet name to "Sheet1"
everything else is good

p.s
first cell has no header

Sheet1.xlsx
	A	B	C	D
1	1	1	2	2
2	1	1	2	3
3	1	1	2	4
Sheet1

also the file length is about 4k lines

 

[Siddharth Rout]

only the sheet name to "Sheet1"
everything else is good

p.s
first cell has no header

Sheet1.xlsx
	A	B	C	D
1	1	1	2	2
2	1	1	2	3
3	1	1	2	4
Sheet1

also the file length is about 4k lines

Which line does it highlight when you get the error?

 

[excelNewbie22]

the highlighted was :

Set ws = Sheet1

search google and tried changing to:

 Set ws = ThisWorkbook.Worksheets(1)

it worked
but it deleted too many lines in the 4k lines file
for the example above it deleted all lines
were it should delete only lines numbers: 8-9-10-14-15-16-17-21

 

[Siddharth Rout]

the highlighted was :

Set ws = Sheet1

search google and tried changing to:

 Set ws = ThisWorkbook.Worksheets(1)

it worked
but it deleted too many lines in the 4k lines file
for the example above it deleted all lines
were it should delete only lines numbers: 8-9-10-14-15-16-17-21

Sheet1 in my code was the code name of the worksheet. You can see the code name from the Visual basic Editor Project Explorer. It is advisable to either use the code name or use something like ThisWorkbook.Worksheets("SomeName"), where "SomeName" is the name of worksheet. If there is only 1 worksheet in the workbook then it is ok to use ThisWorkbook.Worksheets(1) but if you have more than 1, it is not advisable to use this because you many never know which sheet might be at the 1st index.

Can you share the exact code that you are using?

 

[excelNewbie22]

thanks for explaining

the code you gave me:

Option Explicit

Sub Sample()
    Dim col As New Collection
    Dim itm As Variant
    Dim i As Long, j As Long, k As Long
    Dim lRow As Long
    Dim MyArray() As String
    Dim ws As Worksheet
    Dim IsInArray As Boolean
 
    '~~> Change this to the relevant Sheet
    Set ws = ThisWorkbook.Worksheets(1)
 
    '~~> Change the dimension as required.
    '~~> Any number other than these will be deleted
    Dim ExcludeArray(1 To 3) As Variant
    ExcludeArray(1) = 5
    ExcludeArray(2) = 6
    ExcludeArray(3) = 7
 
    With ws
        .AutoFilterMode = False
    
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
    
        '~~> Get a unique count of items in the column. Assuming first cell has Header
        For i = 2 To lRow
            On Error Resume Next
            col.Add .Cells(i, 1).Value2, CStr(.Cells(i, 1).Value2)
            On Error GoTo 0
        Next i
    
        k = col.Count
    
        '~~> Find how many numbers are there which needs to be deleted
        For Each itm In col
            For j = LBound(ExcludeArray) To UBound(ExcludeArray)
                If itm = ExcludeArray(j) Then
                    k = k - 1
                    Exit For
                End If
            Next j
        Next itm
            
        '~~> Store the numbers to be deleted in an array
        ReDim MyArray(1 To k)
        k = 1
    
        For Each itm In col
            On Error Resume Next
            IsInArray = Application.Match(itm, ExcludeArray, 0)
            On Error GoTo 0
    
            If IsInArray = False Then
                MyArray(k) = itm
                k = k + 1
            Else
                IsInArray = False
            End If
        Next itm
    
        '~~> Use Autofilter to delete the rows in 1 go
        With .Range("A1:A" & lRow)
            .AutoFilter Field:=1, Criteria1:=MyArray, Operator:=xlFilterValues
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With
    
       .AutoFilterMode = False
    End With
End Sub

 

[Siddharth Rout]

1. Since there are no headers,

For i = 2 To lRow

becomes

For i = 1 To lRow

2. I see you have not changed the numbers to be exlcuded. It is still 5,6 and 7. So any other number other than these will be deleted. Lets say you do not want to delete 1,4,8,10 then you need to change

    Dim ExcludeArray(1 To 3) As Variant
    ExcludeArray(1) = 5
    ExcludeArray(2) = 6
    ExcludeArray(3) = 7

to

    Dim ExcludeArray(1 To 4) As Variant
    ExcludeArray(1) = 1
    ExcludeArray(2) = 4
    ExcludeArray(3) = 8
    ExcludeArray(4) = 10

So now amend the code to accordingly and try again?