adjusting a macro for delete rows with certain numbers only

excelNewbie22

Active Member
hi!

i had a mistake (sorry) back then explaining this:
(in here i use the numbers 1-4-9 but now i use others)

cause i need something slightly else, and i'll try to elaborate:

i need the macro to delete any lines/rows with the combination of 4 numbers (a1:d1, a2:d2 and etc) containing only the numbers 1-5-7 like 1577 or 7117 or 7115 or 7775,
but to keep lines with only part of them like 1572 or 1178 or 7558
so basically to delete lines containing only these numbers 1-5-7 and nothing else
if the line contains any other number then 1-5-7 it stays

sheet1
ABCDE
11146keep
21147keep
31148keep
41151delete
51152keep
61153keep
71154keep
81155delete
91257keep
101178keep
117558keep
127775delete
135177delete
sheet1

VBA Code:
``````Sub RemoveRowsIf()
'removes entire rows containing Num1 and Num2 and Num3
'assumes data start in cell A1
Dim R As Range, V As Variant, i As Long, j As Long, Ct As Long, d As Object
Const Num1 As Long = 1: Const Num2 As Long = 5: Const Num3 As Long = 7   ' change Nums to suit
Set R = Range("A1").CurrentRegion
Set d = CreateObject("Scripting.dictionary")
V = R.Value
For i = 1 To UBound(V, 1)
For j = 1 To UBound(V, 2)
If V(i, j) = Num1 Or V(i, j) = Num2 Or V(i, j) = Num3 Then
If Not d.exists(V(i, j)) Then
d.Add V(i, j), ""
Ct = Ct + 1
If Ct = 3 Then
V(i, j) = "#N/A"
GoTo Nx
End If
End If
End If
Next j
Nx: d.RemoveAll
Ct = 0
Next i
R.Value = V
On Error Resume Next
R.SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
On Error GoTo 0
End Sub``````

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Code:
``````Sub DeleteMyRows()
'
Dim colNums As New Collection
Dim bBad As Boolean
Dim vNum
On Error GoTo ErrBad
'hold special numbers

Range("A1").Select
Dim iRows As Long
iRows = ActiveSheet.UsedRange.Rows.Count
'goto bottom
Cells(iRows, 1).Select
While ActiveCell.Row >= 1
ActiveCell.Offset(0, 1).Select
While ActiveCell.Value <> "" And Not bBad
vNum = ActiveCell.Value
If colNums(CStr(vNum)) = CStr(vNum) Then
Beep
Else
End If

ActiveCell.Offset(0, 1).Select  'next col
Wend
GoSub KillRow
skip:
ActiveCell.Offset(-1, 0).Select  'prev row
Cells(ActiveCell.Row, 1).Select
Wend
Exit Sub

KillRow:
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Delete
Return

If Err = 5 Then  'dont delete
Resume skip
Else
MsgBox Err.Description, , Err
End If
Exit Sub
Resume
End Sub``````

thank you ranman256,
but it is not working and it's returning an error

for the example above it's good
but for the full file, 4k lines, it does not
it's delete lines which shouldn't get deleted

Last edited:
for example it delete lines with
8-7-1-1
8-5-7-1
8-5-7-7
6-7-5-5

Hi, according to Excel basics a VBA demonstration for starters :​
VBA Code:
``````Sub Demo1()
Const C = 4
Dim N%(), R&
With [A1].CurrentRegion.Resize(, C).Rows
ReDim N(1 To .Count, 0)
For R = 1 To .Count
N(R, 0) = -(Application.Count(Application.Match(.Item(R), [{1,5,7}], 0)) = C)
Next
R = Application.Sum(N)
If R Then
Application.ScreenUpdating = False
.Columns(C + 1).Value2 = N
.Resize(, C + 1).Sort .Columns(C + 1), 1, Header:=2
Union(.Columns(C + 1), .Item(.Count - R + 1 & ":" & .Count)).Clear
Application.ScreenUpdating = True
End If
End With
End Sub``````

thank you marc!

Replies
4
Views
165
Replies
12
Views
219
Replies
5
Views
390
Replies
1
Views
758
Replies
6
Views
87

1,203,502
Messages
6,055,772
Members
444,822
Latest member
Hombre

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back