Populate a cell based on a keyword it found in another

Hi

I'm well out of my league on this one but its something that I really need to do and was hoping someone could help

I have a column called Screener and each cell in that column contains text data such as the following example

S1 ~ The specimen is satisfactory for evaluation. ~ 01;G1 ~ Negative for intraepithelial lesion or malignancy. ~ 01;R1 ~ The next smear should be taken at the usual screening interval. ~ 01

Another cell might contain different text

I cant change this as it is generated by software that I use and I export that data to a spreadsheet.

What I need to do is run a macro to look at that text above along the lines of - if the text in that cell contains the word S1 or the word ASCUS or any other combination of words, then it will assign a text value to it such as 'LG'. If it found some other word in that text above then it might assign a different text type e.g if it found the word HS1 then it would assign a value of 'HG'. It would put that assigned value into a new column. It would then move to the next cell in that column and perform the same function and so on.

So essentially I would like to compress all that text above into one word depending on what key words it finds in that text. I have upwards of several hundred records which I have to manually determine whether its and LG or HG or something else and it would make life so much easiier if I could read one word rather than a whole string of text. I can then sort the data based on that new word it generated. Hope I've made that clear. I have attached an example of what I'm trying to acheive.

Any help would be most appreciated - I just dont have the necessary skills to do this and was hoping someone out there would know the code I would need to enter into the macro to acheive this end. Someone did suggest an array formula but I would much rather stick with a macro as I have less a grasp with formulae than I do with VBA.

kind regards

Steve

I didn't look at your zip file (call me paranoid) so I hope this is enough to get you started. It's probably not the most efficient but it works.

Sub Test()
Dim Screener As String
Screener = "C" 'Change this to the proper column

Dim Criteria1 As String
Dim Criteria2 As String
Dim Criteria3 As String
Criteria1 = "S1" 'Change as needed
Criteria2 = "ASCUS" 'Change as needed
Criteria3 = "HS1" 'Change as needed
'(you can add more criterias if needed)
'Note: "HS1" criteria comes AFTER "S1" not before
'Note: search is Case Sensitive

Range(Screener & "2").Select 'Assumes that you have a header in Row 1

Dim iRow As Integer
Dim iTotalRows As Integer
iRow = 0
iTotalRows = ActiveSheet.UsedRange.Rows.Count

Do
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria1 & "*" Then ActiveCell.Offset(iRow, 1).Value = "LG"
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria2 & "*" Then ActiveCell.Offset(iRow, 1).Value = "LG"
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria3 & "*" Then ActiveCell.Offset(iRow, 2).Value = "HG"
iRow = iRow + 1
Loop Until iRow = iTotalRows - 1

End Sub

Originally Posted by ghobbit

Hi

I'm well out of my league on this one but its something that I really need to do and was hoping someone could help

I have a column called Screener and each cell in that column contains text data such as the following example

S1 ~ The specimen is satisfactory for evaluation. ~ 01;G1 ~ Negative for intraepithelial lesion or malignancy. ~ 01;R1 ~ The next smear should be taken at the usual screening interval. ~ 01

Another cell might contain different text

I cant change this as it is generated by software that I use and I export that data to a spreadsheet.

What I need to do is run a macro to look at that text above along the lines of - if the text in that cell contains the word S1 or the word ASCUS or any other combination of words, then it will assign a text value to it such as 'LG'. If it found some other word in that text above then it might assign a different text type e.g if it found the word HS1 then it would assign a value of 'HG'. It would put that assigned value into a new column. It would then move to the next cell in that column and perform the same function and so on.

So essentially I would like to compress all that text above into one word depending on what key words it finds in that text. I have upwards of several hundred records which I have to manually determine whether its and LG or HG or something else and it would make life so much easiier if I could read one word rather than a whole string of text. I can then sort the data based on that new word it generated. Hope I've made that clear. I have attached an example of what I'm trying to acheive.

Any help would be most appreciated - I just dont have the necessary skills to do this and was hoping someone out there would know the code I would need to enter into the macro to acheive this end. Someone did suggest an array formula but I would much rather stick with a macro as I have less a grasp with formulae than I do with VBA.

kind regards

Steve

Hi

Many thanks for that - I'll have a play with it shortly.

At the risk of appearing a bit cheeky though can I ask another thing? In the attachment I posted (I understand you not wanting to open it) it had one example of where a cell contains the text ;;;LSIL- CIN1/HPV (with all the semi colons). I assume from your code that it'll be able to see LSIL which is the bit I'd be interested in and do what I wanted it to do.

However in the cell below it is another text which is ;;;LSIL- CIN1/HPV;ASC-H

ASC-H has a higher priority than LSIL (they're in reference to types of cancers) so that would have to take preference. Is it possible to manipulate the code in some way so that if it sees one thing such as LSIL it would assign one code such as LG (low Grade) but if it sees a combination with both LSIL AND ASC-H (High Grade) then ASC-H would take preference and HG would duly be assigned into the column.

Sounds a bit complicated. But I need some flexibility to be able to add and change things as necessary. I cant write VBA (well not very much) but I can generally read it and get a feel for whats going on and I'll have a play with your code that you've posted.

Many thanks for that - most appreciated

steve

It will indeed find the LSIL.
In the attachment I posted (I understand you not wanting to open it) it had one example of where a cell contains the text ;;;LSIL- CIN1/HPV (with all the semi colons). I assume from your code that it'll be able to see LSIL which is the bit I'd be interested in and do what I wanted it to do.

in the code:

Do
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria1 & "*" Then ActiveCell.Offset(iRow, 1).Value = "LG"
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria2 & "*" Then ActiveCell.Offset(iRow, 1).Value = "LG"
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria3 & "*" Then ActiveCell.Offset(iRow, 2).Value = "HG"
iRow = iRow + 1
Loop Until iRow = iTotalRows - 1

each if/statement will overwrite the ones above it. So if the cell contains Criteria1 and Criteria3, the results will be Criteria3 (i.e. "HG").
However in the cell below it is another text which is ;;;LSIL- CIN1/HPV;ASC-H
ASC-H has a higher priority than LSIL (they're in reference to types of cancers) so that would have to take preference. Is it possible to manipulate the code in some way so that if it sees one thing such as LSIL it would assign one code such as LG (low Grade) but if it sees a combination with both LSIL AND ASC-H (High Grade) then ASC-H would take preference and HG would duly be assigned into the column.

I hope that helps. Let me know.
-Ikaabod

Hi

Many thanks for your help and explainations.

I tweaked the code a little as per the instructions you included with it and it works more or less as I had hoped it would. Except for a couple of things - here is the code as I have it at the moment

Sub Test()
Dim Screener As String
Screener = "A" 'Change this to the proper column

Dim Criteria1 As String
Dim Criteria2 As String
Dim Criteria3 As String
Dim Criteria4 As String
Dim Criteria5 As String

Criteria1 = "LSIL" 'Change as needed
Criteria2 = "ASC-US" 'Change as needed
Criteria3 = "ASC-H" 'Change as needed
Criteria4 = "HSIL" 'Change as needed
Criteria5 = "G1" 'Change as needed


'(you can add more criterias if needed)
'Note: "HS1" criteria comes AFTER "S1" not before
'Note: search is Case Sensitive

Range(Screener & "2").Select 'Assumes that you have a header in Row 1

Dim iRow As Integer
Dim iTotalRows As Integer
iRow = 0
iTotalRows = ActiveSheet.UsedRange.Rows.Count

Do
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria1 & "*" Then ActiveCell.Offset(iRow, 1).Value = "LG"
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria2 & "*" Then ActiveCell.Offset(iRow, 1).Value = "LG"
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria3 & "*" Then ActiveCell.Offset(iRow, 2).Value = "HG"
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria4 & "*" Then ActiveCell.Offset(iRow, 1).Value = "HG"
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria5 & "*" Then ActiveCell.Offset(iRow, 1).Value = "NEG"

‘If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria6 & "*" Then ActiveCell.Offset(iRow, 2).Value = "HG"

iRow = iRow + 1
Loop Until iRow = iTotalRows - 1

End Sub


I noticed where it says
Range(Screener & "2").Select 'Assumes that you have a header in Row 1

I had a header and when I ran the macro it did its job down to all but the last row. I had 30 rows for this test and the macro went from row 2 down to row 29. So I added some more rows so that I had 60 in all and re-ran the macro. This time it went down to row 59 - how do I get it to go all the way to the bottom regardless of how many rows I have?

Lastly you said that
each if/statement will overwrite the ones above it. So if the cell contains Criteria1 and Criteria3, the results will be Criteria3 (i.e. "HG").

It might be that I've got my wires crossed and havent got the above in the right order but in a cell I have LSIL-CIN I/HPV:ASC-H

Going by the criteria order above - it should look at LSIL first and therefore its a 'LG' however Criteria 3 finds ASC-H and therefore it overwrites 'LG' and makes it a 'HG'

So far this isnt happened. What its doing is looking in A2 and finding LSIL-CIN I/HPV:ASC-H and putting the 'LG' in B2 and then it puts 'HG' in C2 rather overwriting 'LG' in B2. I would prefer it to overwrite it - is this supposed to happen or have I done something wrong?

many thanks for your time and patience.

regards

Steve

Hi, sorry. Those were my fault I think. This should do it though. The reason it was going to the cell to the right was because of the "2" for the column in the if/statement... I changed them back to "1". Also, the error in it checking all but the last row should now be fixed as well.

Sub Test()
Dim Screener As String
Screener = "A" 'Change this to the proper column

Dim Criteria1 As String
Dim Criteria2 As String
Dim Criteria3 As String
Dim Criteria4 As String
Dim Criteria5 As String

Criteria1 = "LSIL" 'Change as needed
Criteria2 = "ASC-US" 'Change as needed
Criteria3 = "ASC-H" 'Change as needed
Criteria4 = "HSIL" 'Change as needed
Criteria5 = "G1" 'Change as needed


'(you can add more criterias if needed)
'Note: "HS1" criteria comes AFTER "S1" not before
'Note: search is Case Sensitive

Range(Screener & "2").Select 'Assumes that you have a header in Row 1

Dim iRow As Integer
Dim iTotalRows As Integer
iRow = 0
iTotalRows = ActiveSheet.UsedRange.Rows.Count

Do
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria1 & "*" Then ActiveCell.Offset(iRow, 1).Value = "LG"
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria2 & "*" Then ActiveCell.Offset(iRow, 1).Value = "LG"
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria3 & "*" Then ActiveCell.Offset(iRow, 1).Value = "HG"
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria4 & "*" Then ActiveCell.Offset(iRow, 1).Value = "HG"
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria5 & "*" Then ActiveCell.Offset(iRow, 1).Value = "NEG"

'If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria6 & "*" Then ActiveCell.Offset(iRow, 1).Value = "HG"

iRow = iRow + 1
Loop Until iRow = iTotalRows

End Sub

Originally Posted by ghobbit

Hi

Many thanks for your help and explainations.

I tweaked the code a little as per the instructions you included with it and it works more or less as I had hoped it would. Except for a couple of things - here is the code as I have it at the moment

Sub Test()
Dim Screener As String
Screener = "A" 'Change this to the proper column

Dim Criteria1 As String
Dim Criteria2 As String
Dim Criteria3 As String
Dim Criteria4 As String
Dim Criteria5 As String

Criteria1 = "LSIL" 'Change as needed
Criteria2 = "ASC-US" 'Change as needed
Criteria3 = "ASC-H" 'Change as needed
Criteria4 = "HSIL" 'Change as needed
Criteria5 = "G1" 'Change as needed


'(you can add more criterias if needed)
'Note: "HS1" criteria comes AFTER "S1" not before
'Note: search is Case Sensitive

Range(Screener & "2").Select 'Assumes that you have a header in Row 1

Dim iRow As Integer
Dim iTotalRows As Integer
iRow = 0
iTotalRows = ActiveSheet.UsedRange.Rows.Count

Do
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria1 & "*" Then ActiveCell.Offset(iRow, 1).Value = "LG"
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria2 & "*" Then ActiveCell.Offset(iRow, 1).Value = "LG"
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria3 & "*" Then ActiveCell.Offset(iRow, 2).Value = "HG"
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria4 & "*" Then ActiveCell.Offset(iRow, 1).Value = "HG"
If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria5 & "*" Then ActiveCell.Offset(iRow, 1).Value = "NEG"

‘If ActiveCell.Offset(iRow, 0).Value Like "*" & Criteria6 & "*" Then ActiveCell.Offset(iRow, 2).Value = "HG"

iRow = iRow + 1
Loop Until iRow = iTotalRows - 1

End Sub


I noticed where it says
Range(Screener & "2").Select 'Assumes that you have a header in Row 1

I had a header and when I ran the macro it did its job down to all but the last row. I had 30 rows for this test and the macro went from row 2 down to row 29. So I added some more rows so that I had 60 in all and re-ran the macro. This time it went down to row 59 - how do I get it to go all the way to the bottom regardless of how many rows I have?

Lastly you said that
each if/statement will overwrite the ones above it. So if the cell contains Criteria1 and Criteria3, the results will be Criteria3 (i.e. "HG").

It might be that I've got my wires crossed and havent got the above in the right order but in a cell I have LSIL-CIN I/HPV:ASC-H

Going by the criteria order above - it should look at LSIL first and therefore its a 'LG' however Criteria 3 finds ASC-H and therefore it overwrites 'LG' and makes it a 'HG'

So far this isnt happened. What its doing is looking in A2 and finding LSIL-CIN I/HPV:ASC-H and putting the 'LG' in B2 and then it puts 'HG' in C2 rather overwriting 'LG' in B2. I would prefer it to overwrite it - is this supposed to happen or have I done something wrong?

many thanks for your time and patience.

regards

Steve

Hi

Works like a charm. I've been able to follow what you've done and have managed to tweak it and get it to check a couple of columns at a time. The code doesnt look pretty and I'm sure it could be tidied up a bit but it works and thats what matters.

Many thanks for your efforts

best regards

steve

There are many ways to skin a cat :-)
I'm glad it works tho. Best wishes.
-Ikaabod

Originally Posted by ghobbit

Hi

Works like a charm. I've been able to follow what you've done and have managed to tweak it and get it to check a couple of columns at a time. The code doesnt look pretty and I'm sure it could be tidied up a bit but it works and thats what matters.

Many thanks for your efforts

best regards

steve

Hi Ikaabod

Sorry to bother you again but I was hoping for some guidance on the next bit

I now have a number of rows and in cell B2 I have the string 'LG' and in cell C2 I have 'Neg'. What I would like to do now is compare the two and then give me an output to another cell.

I think I need to use the StrComp function and I'm thinking along the lines of this

Private Sub cmdCreate_Click()
Dim strValue1 As String
Dim strValue2 As String
Dim Criteria1 = LG As String
Dim Criteria2 = HGI As String
Dim Criteria3 = HGII As String
Dim Criteria4 = AGUS As String

Cells(2, "B").value = strValue1
Cells(2, "C").value = strValue2
iComparisonValue = StrComp(strValue1, strValue2, vbTextCompare)

' I now need it to make the comparisons

Dim iRow As Integer
Dim iTotalRows As Integer
iRow = 0
iTotalRows = ActiveSheet.UsedRange.Rows.Count

Do
If ActiveCell.Offset(2, "B").Value IS "Neg" AND ActiveCell.Offset(2 , "C").Value Is Criteria1 OR Criteria2 OR Criteria3 OR Criteria4 Then ActiveCell.Offset(2, "D").Value = "FN"

iRow = iRow + 1
Loop Until iRow = iTotalRows
End Sub


I know this is wrong but hopefully you can see from it what I'm trying to do. I then need it to loop and go down all the rows.

Any help or pointers would as always be most appreciated.

regards

steve

Your text and your macro seem to contradict one another... but let's see if I interpretted correctly. Tell me how this goes for you.

Private Sub cmdCreate_Click()
Dim strValue1 As String
Dim strValue2 As String
Dim Criteria1 As String
Dim Criteria2 As String
Dim Criteria3 As String
Dim Criteria4 As String
Criteria1 = "LG"
Criteria2 = "HGI"
Criteria3 = "HGII"
Criteria4 = "AGUS"

Dim iRow As Integer
Dim iTotalRows As Integer
iRow = 0
iTotalRows = ActiveSheet.UsedRange.Rows.Count
Range("A2").Select
Do
strValue1 = ActiveCell.Offset(iRow, 1).Value
strValue2 = ActiveCell.Offset(iRow, 2).Value
If (strValue1 = Criteria1 And UCase(strValue2) = UCase("Neg")) Or (strValue1 = Criteria2 And UCase(strValue2) = UCase("Neg")) Or (strValue1 = Criteria3 And UCase(strValue2) = UCase("Neg")) Or (strValue1 = Criteria4 And UCase(strValue2) = UCase("Neg")) Then ActiveCell.Offset(iRow, 3).Value = "FN"
Debug.Print ActiveCell.Offset(iRow, 1).Address
iRow = iRow + 1
Loop Until iRow = iTotalRows
End Sub

Best regards,
Ikaabod

Hi Ikaabod

Thanks for your reply.

I tried it and nothing happened. I worked my way through the code and thought would this work instead

Sub Test()
Dim strValue1 As String
Dim strValue2 As String
Dim Criteria1 As String
Dim Criteria2 As String
Dim Criteria3 As String
Dim Criteria4 As String
Criteria1 = "NEG"
Criteria2 = "LG"
Criteria3 = "HGI"
Criteria4 = "HGII"
Criteria5 = "AGUS"

Dim iRow As Integer
Dim iTotalRows As Integer
iRow = 0
iTotalRows = ActiveSheet.UsedRange.Rows.Count
Range("A2").Select
Do
strValue1 = ActiveCell.Offset(iRow, 1).Value
strValue2 = ActiveCell.Offset(iRow, 2).Value
If (strValue1 = Criteria1 And strValue2 = Criteria2) Or (strValue1 = Criteria1 And strValue2 = Criteria3) Or (strValue1 = Criteria1 And strValue2 = Criteria4) Or (strValue1 = Criteria1 And strValue2 = Criteria5) Then ActiveCell.Offset(iRow, 3).Value = "FN"
Debug.Print ActiveCell.Offset(iRow, 1).Address
iRow = iRow + 1
Loop Until iRow = iTotalRows


End Sub

It didnt work either - no error messages or anything as on your original code.

I saw on your code you had used the 'UCase' - probably because I had used lowercase before however that was my mistake as 'Neg' is uppercase anyway. I have added an extra Criteria and called it 'NEG' and re-written the code slightly which hopefully will show a bit better what I'm trying to achieve.

Many thanks

Steve

Hi Ikaabod

I've been playing around and so far this does pretty much what I want it to do

Sub Test()

Dim strValue1 As String
Dim strValue2 As String
Dim Criteria1 As String
Dim Criteria2 As String
Dim Criteria3 As String
Dim Criteria4 As String
Dim Comparison As String


Criteria1 = "NEG"
Criteria2 = "LG"
Criteria3 = "HG I"
Criteria4 = "HG II"
Criteria5 = "AGUS"

Range("A1").Select

Dim iRow As Integer
Dim iTotalRows As Integer

iRow = 0
iTotalRows = ActiveSheet.UsedRange.Rows.Count

Do

strValue1 = ActiveCell.Offset(iRow, 0).Value
strValue2 = ActiveCell.Offset(iRow, 1).Value

If strValue1 = Criteria2 Or strValue1 = Criteria3 Or strValue1 = Criteria4 Or strValue1 = Criteria5 And strValue2 = Criteria1 Then ActiveCell.Offset(iRow, 3).Value = "FP"
If strValue1 = Criteria1 And strValue2 = Criteria2 Or strValue2 = Criteria3 Or strValue2 = Criteria4 Or strValue2 = Criteria5 Then ActiveCell.Offset(iRow, 3).Value = "FN"
If strValue1 = Criteria1 And strValue2 = Criteria1 Then ActiveCell.Offset(iRow, 3).Value = "AGREE"
If strValue1 = Criteria2 And strValue2 = Criteria2 Then ActiveCell.Offset(iRow, 3).Value = "AGREE"
If strValue1 = Criteria3 And strValue2 = Criteria3 Then ActiveCell.Offset(iRow, 3).Value = "AGREE"
If strValue1 = Criteria4 And strValue2 = Criteria4 Then ActiveCell.Offset(iRow, 3).Value = "AGREE"
If strValue1 = Criteria5 And strValue2 = Criteria5 Then ActiveCell.Offset(iRow, 3).Value = "AGREE"



iRow = iRow + 1
Loop Until iRow = iTotalRows



End Sub

I know there are a lot of 'If' statements and I'll have a go and try and tidy them up a bit but I'm not too concerned as it does work.

I couldnt have done it without your help though - many thanks

Now all I have to do is get it to add up all the 'FN' ' s and the 'FP''s and 'AGREE''s and It'll be all done

Again thanks for your time and efforts.

regards

steve

For adding those up you can use this formula:

=SUMPRODUCT(--(A1:A7="FN")+--(A1:A7="FP")+--(A1:A7="AGREE"))

Where A1:A7 is the range of data you want to search for those keywords in. If one of the words is found it adds one.

if A1:A7 was:
dfns
FN
FP
AGREE
sdfp
FN
FP
it would return the value 5.

Best of luck to you.