I'm stumped. For the life of me, I can not get these two Subs to work as one. Can someone take a look and give me a suggestion...
Sub JabClass()
Dim rngFound As Range, rngToDelete As Range
Dim strFirstAddress As String
Dim varList As Variant
Dim lngCounter As Long
Application.ScreenUpdating = False
varList = VBA.Array("*BATTERY*", "*LABEL*", "*DIE CUT*", "*KEYPAD*", "*MECHANICAL*", _
"*METAL*", "*Assem*", "*PACKAG*", "*PCB*", "*PLASTICS*", "*PREPPED*", "*PRINT*", _
"*PURCHASED*", "*PWA*", "*NON MANUF*", "*UNCLASS*")
For lngCounter = LBound(varList) To UBound(varList)
With Sheet1.Range("C:C")
Set rngFound = .Find( _
What:=varList(lngCounter), _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True _
)
If Not rngFound Is Nothing Then
If rngToDelete Is Nothing Then
Set rngToDelete = rngFound
Else
Set rngToDelete = Application.Union(rngToDelete, rngFound)
End If
strFirstAddress = rngFound.Address
Set rngFound = .FindNext(After:=rngFound)
Do Until rngFound.Address = strFirstAddress
Set rngToDelete = Application.Union(rngToDelete, rngFound)
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With
Next lngCounter
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
Application.ScreenUpdating = True
End Sub
***********************************************************************************
Sub JabMFR()
Dim rngFound As Range, rngToDelete As Range
Dim strFirstAddress As String
Dim varList As Variant
Dim lngCounter As Long
Application.ScreenUpdating = False
varList = VBA.Array("*AAVID*", "*ALUMINUM*", "*ARROW ELECTR*", "*BALL CHAIN*", "*BEARING*", "*BELTING*", _
"*BOOTH FELT*", "*BRISTOL TAPE*", "*BSC FILTERS*", "*BUMPER SPECIALITIES*", "*CLEAN TEAM PRODUCTS*", "*DIE CAST*", _
"*DIE CUT*", "*DIEMASTERS*", "*DIGI KEY*", "*DIGIKEY*", "*DIGI-KEY*", "*ENDRIES INTER*", "*FAB*", "*FIBREGLASS*", _
"*FOAMS", "*FSP GROUP*", "*FU YU MAN*", "*GASKET*", "*LABEL*", "*LEATHER*", "*MACHIINERY*", "*MACHINING*", _
"*MAG LAYERS*", "*METAL*", "*MOLD*", "*NMB MINEBEA*", "*ORIENTAL PRINTED CIRC*", "*PACK**", "*PLASTEC*", "*PLASTIC*", _
"*PRINTING*", "*PRINTEC H.T.*", "*RICHCO INC*", "*RUBBER*", "*SCREWS*", "*SEALED AIR*", "*SHANGHAI HONGTAO *", _
"*SIGNATURE CABLE MANU*", "*SPRING*", "*STAMP*", "*STOCKER HINGE**", "*TELFORD SERVICE*", "*TOOL*", "*WIRE & CABLE*", _
"*ZEBRA TECHNOLOGIES*")
For lngCounter = LBound(varList) To UBound(varList)
With Sheet1.Range("F:F")
Set rngFound = .Find( _
What:=varList(lngCounter), _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True _
)
If Not rngFound Is Nothing Then
If rngToDelete Is Nothing Then
Set rngToDelete = rngFound
Else
Set rngToDelete = Application.Union(rngToDelete, rngFound)
End If
strFirstAddress = rngFound.Address
Set rngFound = .FindNext(After:=rngFound)
Do Until rngFound.Address = strFirstAddress
Set rngToDelete = Application.Union(rngToDelete, rngFound)
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With
Next lngCounter
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
Application.ScreenUpdating = True
End Sub
Bookmarks