Hi
Try something like this.
Code:Sub kTest() Dim i As Long, j As Long, r As Range, ff As String Dim SearchKeys1, SearchKeys2, SearchKeysAll, Replacement SearchKeys1 = Array("Open", "Received") SearchKeys2 = Array("Approved", "Disassemble") SearchKeysAll = Array(SearchKeys1, SearchKeys2) Replacement = Array("Gate 1", "Gate 2") With Intersect(ActiveSheet.UsedRange, Columns(5)) For i = LBound(Replacement) To UBound(Replacement) For j = LBound(SearchKeysAll(i)) To UBound(SearchKeysAll(i)) Set r = .Find(SearchKeysAll(i)(j), lookat:=2) If Not r Is Nothing Then ff = r.Address Do Set r = .FindNext(r) r.Offset(, 4) = Replacement(i) Loop Until r.Address = ff End If Next Next End With End Sub




Reply With Quote
Bookmarks