Try this
Code:Sub ProcessLookUpValues() Dim X As Long, Z As Long, Index As Long Dim ArrLookUp As Variant, ArrIn As Variant, ArrOut As Variant, Counts As Variant Columns("E:H").ClearContents ArrLookUp = Range("C2:D" & Application.Max(Cells(Rows.Count, "C").End(xlUp).Row, Cells(Rows.Count, "D").End(xlUp).Row)) ReDim Counts(1 To UBound(ArrLookUp), 1 To 1) ArrIn = Range("A2:B" & Cells(Rows.Count, "A").End(xlUp).Row) ReDim ArrOut(1 To UBound(ArrIn) + UBound(ArrLookUp), 1 To 3) For Z = 1 To UBound(ArrLookUp) For X = 1 To UBound(ArrIn) If UCase(ArrIn(X, 1)) Like "*" & UCase(ArrLookUp(Z, 1)) & "*" And UCase(ArrIn(X, 1)) Like "*" & UCase(ArrLookUp(Z, 2)) & "*" Then Counts(Z, 1) = Counts(Z, 1) + 1 Index = Index + 1 ArrOut(Index, 1) = ArrIn(X, 1) ArrOut(Index, 2) = ArrIn(X, 2) ArrOut(Index, 3) = Trim(ArrLookUp(Z, 1) & " " & ArrLookUp(Z, 2)) End If Next Index = Index + 1 Next Range("E1:H1") = Array("Count of Lookup Value", "Result 1", "Result 2", "Result 3 (Lookup Value)") Range("E2:E" & 1 + UBound(ArrLookUp)) = Counts Range("F2:H" & UBound(ArrOut)) = ArrOut End Sub




Reply With Quote
Bookmarks