Cell Filling
 

Currently this macro takes the contents in column K in any combination in any
order, possibly with other words in between, before, or behind them, but as
long as all the words in the line of the code are present and only when all
the words in the line of the code are present a number that is associated to
that line will be entered into the same row in Column I. I am trying to
change the numbers for each line that are going into Column I. I put the
associated number I am aiming to get into Column I next to the line of the
macro that is associated to it. Thank you for your help.


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

arrVals(1, 0) = "Give": arrVals(1, 1) = "Wait": arrVals(1, 2) = "Agree"
(Column I = 05)
arrVals(1, 0) = "Give": arrVals(1, 1) = "Wait": arrVals(1, 2) = "From"
(Column I = 06)
arrVals(0, 0) = "Give": arrVals(0, 1) = "Wait" (Column I = 04)
arrVals(1, 0) = "Give": arrVals(1, 1) = "Wait": arrVals(1, 2) = "Release"
(Column I = 09)
arrVals(0, 0) = "Give": arrVals(0, 1) = "Agree" (Column I = 5)
arrVals(1, 0) = "Give": arrVals(1, 1) = "No": arrVals(1, 2) = "Agree"
(Column I = 10)
arrVals(1, 0) = "Give": arrVals(1, 1) = "From" (Column I = 06)
arrVals(2, 0) = "Give": arrVals(2, 1) = "Gave" (Column I = 08)
arrVals(1, 0) = "Give": arrVals(1, 1) = "Take": arrVals(1, 2) = "No" (Column
I = 10)
arrVals(1, 0) = "Give": arrVals(1, 1) = "Take": arrVals(1, 2) = "From"
(Column I = 06)
arrVals(1, 0) = "Give": arrVals(1, 1) = "Take": arrVals(1, 2) = "No":
arrVals(1, 2) = "Stop" (Column I = 10a)
arrVals(2, 2) = "Done": arrVals(2, 3) = "Call" (Column I = 5a)
arrVals(2, 2) = "Give": arrVals(2, 3) = "Call" (Column I = 5a)
arrVals(2, 2) = "Allot" (Column I = 11)
arrVals(2, 2) = "Allot": arrVals(2, 3) = "From" (Column I = 12)
arrVals(2, 2) = "Allot": arrVals(2, 3) = "Agree" (Column I = 12a)
arrVals(0, 0) = "Trade" (Column I = 13)
arrVals(2, 2) = "Trade": arrVals(2, 3) = "Agree" (Column I = 13a)
arrVals(2, 2) = "Discard" (Column I = 14)
arrVals(2, 2) = "Final" (Column I = 15)
arrVals(1, 0) = "Final": arrVals(1, 1) = "Agree" (Column I = 15a)


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

For iRow = 1 To nRow
With Cells(iRow, "K")
For a = 0 To 2
For z = 0 To 4
If arrVals(a, z) = "" Then Exit For
x = InStr(1, .Value, arrVals(a, z))
If x 0 Then y = y + 1
Next z
If y = z Then Cells(iRow, "I") = "0" & z
y = 0
x = 0
Next a
End With
Next iRow

End Sub

Cell Filling
 

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

Cell Filling
 

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