Delete row if "Not" found for Multiple conditions

[learningaccess]

The title may be confusing so I will try to explain better here. I have a
pile of data that I am using a macro to clean up to my liking. I would also
like to use VB to delete any rows that do not contain a specific part number
in column "A" for example:

SPN341014
SPN347016
SPN314017

There are 30 specific part numbers that I would like to limit my data to, so
I would like to for VB to search for those part numbers and delete all of the
other rows.

 

[dmoney]

i would put the pn's that you want to include in an array and test
if column A is not equal to any value in the array then delete the row.

 

[Mike H]

Hi,

A bit thin on detail so some assumptions
The list of data to keep are in sheet 2 column A
Your part numbers are in column A of sheet 1

Right click sheet 1 tab, view code and paste this in and run it

Sub stance()
Dim MyRange1 As Range, MyRange2 As Range, CopyRange As Range
Dim There As Boolean
There = False
'Data to delete
Lastrow1 = Sheets("Sheet1").Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange1 = Sheets("Sheet1").Range("A1:A" & Lastrow1)

'list of code numbers to delete
Lastrow2 = Sheets("Sheet2").Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange2 = Sheets("Sheet2").Range("A1:A" & Lastrow2)

For Each c In MyRange1
For Each d In MyRange2
If c.Value = d.Value Then
There = True
Exit For
End If
Next
If Not There Then
If CopyRange Is Nothing Then
Set CopyRange = c.EntireRow
Else
Set CopyRange = Union(CopyRange, c.EntireRow)
End If
End If
There = False
Next
If Not CopyRange Is Nothing Then
CopyRange.delete
End If
End Sub


Mike

 

[dmoney]

something like this would work -- probably a more efficient method is
available.

Sub arraay()
Dim a As Variant
a = Array(123, 45)
Range("a1").Select

step:
Do Until ActiveCell.Value = ""
If ActiveCell.Value <> a(0) And ActiveCell.Value <> a(1) Then
ActiveCell.EntireRow.Delete
GoTo step
End If
ActiveCell.Offset(1, 0).Activate
Loop
End Sub

 

[learningaccess]

If I wanted to link "Lastrow2" to another workbook as opposed to "Sheet2",
what would the code look like? I tried something on my own and it wouldn't
compile.

Thanks!

 

[learningaccess]

I tried this but it said the part numbers were undefined variables (i.e 123,
45; "variable is undefined")

 

[Mike H]

Hi,

Like this

Lastrow2 = Workbooks("Book2.xls").Sheets("Sheet2").Cells(Cells.Rows.Count,
"A").End(xlUp).Row
Set MyRange2 = Workbooks("Book2.xls").Sheets("Sheet2").Range("A1:A" &
Lastrow2)

This would now use a range from Book2.xls

Mike

 

[learningaccess]

I keep getting a "Runtime error '9': Subscript out of range" on the
"Lastrow2" line. I have triple checked my path and everything seems fine.
Here is the code i am using:

Lastrow2 = Workbooks("C:\Documents and Settings\XXXXX\My Documents\Unit
Manager Files\BPI Part Numbers.xls").Sheets("Sheet1").Cells(Cells.Rows.Count,
"A").End(xlUp).Row
Set MyRange2 = Workbooks("C:\Documents and Settings\XXXXX\My Documents\Unit
Manager Files\BPI Part Numbers.xls").Sheets("Sheet1").Range("A1:A" & Lastrow2)

 

[Mike H]

Hi,

I have no way of checking that path but specifying an incorrect path would
give that error as would not having a sheet1 in that workbook.

Mike

 

[dmoney]

Sub arraay()
Dim a As Variant
a = Array("as123", "bn45")
Range("a1").Select

step:
Do Until ActiveCell.Value = ""
If ActiveCell.Value <> a(0) And ActiveCell.Value <> a(1) Then
ActiveCell.EntireRow.Delete
GoTo step
End If
ActiveCell.Offset(1, 0).Activate
Loop
End Sub



try this -- i put " marks in the array as you are using text and numerical
part numbers.

 

[learningaccess]

I ended up using VBA to open the "BPI Part Numbers.xls" file, copy the table,
insert a sheet and the copied data into the file I am running the macro on,
and used your initial code. Evidently your code did not like the fact that I
was trying to access an external source. It works like a charm now. Thanks!