Originally Posted by
mdmackillop
[VBA]
Option Explicit
Option Compare Text
Sub Data()
Dim Arr, a
Dim Rng As Range, cel As Range
Dim i As Long
Dim Del As Boolean
Arr = Array("PIPE", "ELL", "TEE", "REDUCER", "VALVE", "CAP")
Set Rng = Range(Cells(3, 1), Cells(Rows.Count, 1).End(xlUp))
For i = Rng(Rng.Cells.Count).Row To Rng.Cells(1).Row + 1 Step -1
Del = True
For Each a In Arr
If InStr(1, Cells(i, 1), a) > 0 Then
Cells(i, 6) = Cells(i, 3)
Cells(i, 7) = Cells(i, 4)
Cells(i, 9) = a
Del = False
End If
Next
If Del Then Cells(i, 1).EntireRow.Delete
Next
End Sub
[/VBA]