0

I have a variable set of strings inside the cells to be found in a sheet, like "horse" "apple" "apple/2" "cat", etc.

I need only copy the found string and paste it to next cell.

For example.:

A cell in column B is "Today the horse is happy". So i need only copy the word "horse" and paste it to the next cell. Another cell in column B cointains for example "The cat is sleeping". So i need only copy the word "cat" and paste it to the next cell.

I have a group of possible strings to be found in all column B.

Sub TEST()

Dim c As Range

For Each c In Range("B1:B1500")
    If InStr(1, c.Text, "horse") Then
        c.Copy Destination:=c.Offset(ColumnOffset:=1)
    End If
Next c

End Sub

With that i copy the entire cell cointaining "horse", but i only need the single "horse" word.

Also, i have to duplicate or triple this code only changing the string. Is not a fast way since it will read each cell trying find one string then all the same with next one.

I wanted paste all the strings i want: (cat, horse, appple, etc) then if found one of then in a cell of column B, paste ONLY the found string to next cell.

Someone can help me?

Black Mamba
  • 247
  • 1
  • 12
  • What's the point of copying a string from a cell that you already have? `If InStr(1, c.Text, "horse") Then c.Offset(,1) = "horse"` – Christofer Weber Jun 29 '21 at 21:50
  • This reads like an [XY problem](https://xyproblem.info/) to me – HackSlash Jun 29 '21 at 21:58
  • And [Here](https://stackoverflow.com/questions/46825482/using-an-array-in-instr) - [You](https://stackoverflow.com/questions/43784022/instr-for-array-of-values-possible/43784942) - [Have](https://stackoverflow.com/questions/37234419/vba-using-a-string-array-as-substring-parameter-instr-function-excel) - [Some](https://stackoverflow.com/questions/51907258/using-array-with-instr) relevant links to similar problems for multiple conditions for InStr – Christofer Weber Jun 29 '21 at 21:59
  • Thank you guys! =) – Black Mamba Jun 29 '21 at 22:05

1 Answers1

1

Based on what you described, I think this might work for you.

Sub TEST()

Dim aFindWords
Dim iLoop As Integer
Dim c As Range

aFindWords = Split("horse,cat,apple,apple/2", ",")

For iLoop = LBound(aFindWords) To UBound(aFindWords)
    For Each c In Range("B1:B1500")
        If InStr(1, c.Text, aFindWords(iLoop)) Then
            c.Offset(0, 1) = aFindWords(iLoop)
        End If
    Next c
Next iLoop
End Sub
Dave Lett
  • 88
  • 2