excel VBA finding cells that contains multiple word and write at desired cell

[huiyin9218]

Hi,

How do i write a code to find multiple words (for example: AM and PM) in a column and assign a number "1" at the next 2 columns.
I'm able to find "AM" and assign 1 next to it but i don't know how to add PM into the code and move the number "1" to the next column.
I would be so grateful for your help.


Sub MarkText()
Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

Set ws = ThisWorkbook.Sheets("Sheet1")

Const Text2Find = "AM"
Dim cel As Range
For Each cel In ws.UsedRange.Columns("A").Cells
If InStr(cel.Value, Text2Find) > 0 Then
cel.Offset(0, 1) = 1
Else
cel.Offset(0, 1).ClearContents
End If
Next cel
Next ws
End Sub

 

[JoeMo]

I think this will do what you want. You can include additional words where noted by a comment.

Sub MarkText()
Dim ws As Worksheet, Wrds As Variant
Dim cel As Range

Wrds = Array("AM", "PM")   'Add additional words, if any, here
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
    For Each cel In ws.UsedRange.Columns("A").Cells
        For i = 0 To UBound(Wrds)
            If InStr(cel.Value, Wrds(i)) > 0 Then cel.Offset(0, i + 1) = 1
        Next i
    Next cel
Next ws
Application.ScreenUpdating = True
End Sub

 

[yky]

Try this. Please note that the code only works if "AM" and "PM" are manually entered. If they appear because of formatting, the code will not find them.

Sub MarkText()
    Dim ws As Worksheet
   
    For Each ws In ThisWorkbook.Worksheets
   
    Set ws = ThisWorkbook.Sheets("Sheet1")
   
    'Const Text2Find = "AM"
    Dim cel As Range
    For Each cel In ws.UsedRange.Columns("A").Cells
        If InStr(cel.Value, "AM") > 0 Then
            cel.Offset(0, 1) = 1
        ElseIf InStr(cel.Value, "PM") > 0 Then
            cel.Offset(0, 2) = 1
        Else
            cel.Offset(0, 1).ClearContents
        End If 
    Next cel
    Next ws
End Sub

 

[huiyin9218]

It works! Thank you so much!!!

 

[JoeMo]

It works! Thank you so much!!!

You had two responses to your post. As a courtesy to those who have responded, can you let us know which response is "It"??

 

[huiyin9218]

You had two responses to your post. As a courtesy to those who have responded, can you let us know which response is "It"??

Oh, Sorry. yky's code works for me, JoeMo's works too but the "1"s came out at two different column. I'm still really grateful for the help given. Thank you so much!

 

[JoeMo]

Oh, Sorry. yky's code works for me, JoeMo's works too but the "1"s came out at two different column. I'm still really grateful for the help given. Thank you so much!

In your initial post you wrote: "I'm able to find "AM" and assign 1 next to it but i don't know how to add PM into the code and move the number "1" to the next column.
That's what the code I posted does. If you have both "AM" and "PM" in a single cell, my code will produce a "1" in the adjacent column and another "1" in the column next to that.

 

[huiyin9218]

Sorry for my misleading post. I was trying to have all the "1"s in the same column.
I tried it again and made one small change, it works

Sub MarkText()
Dim ws As Worksheet, Wrds As Variant
Dim cel As Range


Wrds = Array("AM", "PM") 'Add additional words, if any, here
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
For Each cel In ws.UsedRange.Columns("A").Cells
For i = 0 To UBound(Wrds)
If InStr(cel.Value, Wrds(i)) > 0 Then cel.Offset(0, 1) = 1
Next i
Next cel
Next ws
Application.ScreenUpdating = True
End Sub


Thank you for your help

 

[JoeMo]

Sorry for my misleading post. I was trying to have all the "1"s in the same column.
I tried it again and made one small change, it works

Sub MarkText()
Dim ws As Worksheet, Wrds As Variant
Dim cel As Range


Wrds = Array("AM", "PM") 'Add additional words, if any, here
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
For Each cel In ws.UsedRange.Columns("A").Cells
For i = 0 To UBound(Wrds)
If InStr(cel.Value, Wrds(i)) > 0 Then cel.Offset(0, 1) = 1
Next i
Next cel
Next ws
Application.ScreenUpdating = True
End Sub


Thank you for your help

You are welcome.

Maybe it works for your purposes, but you're missing the point. With your modification you don't know which word was found in any specific cell that has one or perhaps both words in it because you overwrite the "1" from the first word with a "1" for the second word. And, you have negated the ability to add more words and know which of them might be in any given cell.

 

[huiyin9218]

I see. excel vba is new to me as I just start learning it recently. Thank you for your guidance, I will take note of it