You are right. This is remarkable. Thank you very much for your help. I
appreciate it immensenly

"Wouter HM" wrote:

Hi Sal,

I have taken some time to look at your request.
It seems to me that you are filling and refilling your arrVals tabel.
At the end of your filling proces only the values below are present:
arrVals(0, 0) = "Trade"
arrVals(0, 1) = "Agree"
arrVals(1, 0) = "Final"
arrVals(1, 1) = "Agree"
arrVals(1, 2) = "Stop"
arrVals(2, 0) = "Give"
arrVals(2, 1) = "Gave"
arrVals(2, 2) = "Final"
arrVals(2, 3) = "Agree"

I do not think that this is what you want.

I changes the dimentions of this array. furthermore I reorded the
filling sequence:
Start with the longest combination of words and the in order of
importance.
What might be missing is some chech on words like "agreement" present
in column K.
At the moment it will be found by the Instr function when looking for
"Agree".

Sub CellFilling()
Dim nRow As Long, iRow As Long
Dim x As Integer, y As Integer, z As Integer, a As Integer
Dim arrVals(20, 3) As Variant, i As Long
Dim ColumnI(20) As String


' Set the order of these rows to
' 1) numbers of words to look for
' 2) importance of combination of words
arrVals(0, 0) = "Give": arrVals(0, 1) = "Take"
arrVals(0, 2) = "No": arrVals(0, 3) = "Stop"
ColumnI(0) = "10a"
arrVals(1, 0) = "Give": arrVals(1, 1) = "Take"
arrVals(1, 2) = "No": ColumnI(1) = "10"
arrVals(2, 0) = "Give": arrVals(2, 1) = "Take"
arrVals(2, 2) = "From": ColumnI(2) = "06"
arrVals(3, 0) = "Give": arrVals(3, 1) = "No"
arrVals(3, 2) = "Agree": ColumnI(3) = "10"
arrVals(4, 0) = "Give": arrVals(4, 1) = "Wait"
arrVals(4, 2) = "Agree": ColumnI(4) = "05"
arrVals(5, 0) = "Give": arrVals(5, 1) = "Wait"
arrVals(5, 2) = "From": ColumnI(5) = "06"
arrVals(6, 0) = "Give": arrVals(6, 1) = "Wait"
arrVals(6, 2) = "Release": ColumnI(6) = "09"
arrVals(7, 0) = "Give": arrVals(7, 1) = "Wait"
ColumnI(7) = "04"
arrVals(8, 0) = "Give": arrVals(8, 1) = "Agree"
ColumnI(8) = "05"
arrVals(9, 0) = "Give": arrVals(9, 1) = "From"
ColumnI(9) = "06"
arrVals(10, 0) = "Give": arrVals(10, 1) = "Gave"
ColumnI(10) = "08"
arrVals(11, 2) = "Done": arrVals(11, 3) = "Call"
ColumnI(11) = "5a"
arrVals(12, 2) = "Give": arrVals(12, 3) = "Call"
ColumnI(12) = "5a"
arrVals(13, 2) = "Allot": arrVals(13, 3) = "From"
ColumnI(13) = "12"
arrVals(14, 2) = "Allot": arrVals(14, 3) = "Agree"
ColumnI(14) = "12a"
arrVals(15, 2) = "Trade": arrVals(15, 3) = "Agree"
ColumnI(15) = "13a"
arrVals(16, 0) = "Final": arrVals(16, 1) = "Agree"
ColumnI(16) = "15a"
arrVals(17, 2) = "Allot": ColumnI(17) = "11"
arrVals(18, 0) = "Trade": ColumnI(18) = "13"
arrVals(19, 2) = "Discard": ColumnI(19) = "14"
arrVals(20, 2) = "Final": ColumnI(20) = "15"

nRow = ActiveSheet.Cells(Rows.Count, "K").End(xlUp).Row


For iRow = 1 To nRow
With Cells(iRow, "K")
For a = 0 To 20
For z = 0 To 3
If arrVals(a, z) = "" Then Exit For
x = InStr(1, .Value, arrVals(a, z), vbTextCompare)
If x = 0 Then Exit For
Next z
If x 0 Then
Cells(iRow, "I").Value = "'" & ColumnI(a)
Exit For
End If
Next a
End With
Next iRow
End Sub



HTH
RadarEye