Remove rows in excel - vba

Question

Here is a tricky question.
I have an Excel file containing roughly 4000 articles in each of the 10 sheets within the workbook. I would like to keep only about 400 articles and the remaining 3600 articles should be removed.
All sheets within the workbook has the article ID in column A.
All sheets has headers on row 1-5.
The article ID can exist more than once in some of the sheets.
I want to list the 400 article ID's in the Visual Basic Script itself so that i don't have to create a separate sheet or column that contains the information.
Can someone please help me? I have tried so many scripts, but nothing seems to work...
In the example below I want to keep Article ID's 5 and 1 (and of course the headers). The remaining 5 rows should be removed
This is what i have tried:
Sub Delete()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With ActiveSheet
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
Firstrow = 6
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For Lrow = Lastrow To Firstrow Step -1
With .Cells(Lrow, "Y")
If Not IsError(.Value) Then
If InStr(.Value, 1) = 0 Or InStr(.Value, 5) = 0 Then .EntireRow.Delete
End If
End With
Next Lrow
End With
End Sub
But, I get two issues:
All rows are removed including the rows that I want to remove (1 and 5).
It only works on the open sheet and not the whole workbook.
Kind regards,
Peter

Answer 1

Try this code. At the start it will ask what IDs you want to keep in all worksheets. There you enter numbers separated by comma (,), no spaces or character other than comma and digits aren't allowed.
Sub DeleteArticles()
Dim i As Long
Dim strIDToKeep As String
Dim arrIDToKeep() As String
Dim ws As Worksheet
Dim lastRow As Long
strIDToKeep = InputBox("What IDs to keep?")
arrIDToKeep = Split(strIDToKeep, ",")
For Each ws In Worksheets
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For i = lastRow To 6 Step -1
'if ID isn't present in array of IDs to keep, then we delete entire row
If UBound(Filter(arrIDToKeep, ws.Cells(i, 1).Value)) = -1 Then
ws.Rows(i).EntireRow.Delete
End If
Next
Next
End Sub

Answer 2

Try this code
Sub Test()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Dim i As Long
For i = 10 To 2 Step -1
Select Case ws.Cells(i, 1).Value
'add your ids for which you don't want to delete the rows
Case 1, 5
'do nothing
Case Else
ws.Cells(i, 1).EntireRow.Delete
End Select
Next i
Next ws
End Sub