Deleting columns depending on position of characters in a string - string

Question

I'm still new to VBA and couldn't find any solution using the search-function so far.
Problem:
I have (in this case ten sheets) a row with over 500 cells containing strings with 5-7 words.
Now I need to delete all columns where the searched word is not the last word,but the word is in all cells (in the row) at different positions in the string.
I tried this:
Dim examinee As Variant
Dim cell As Range
Dim word As String
Dim myCell As String
examinee = InputBox("How many sheets?")
word = InputBox("Looking for?")
For A = 1 To examinee
Sheets("sheet" & A).Select
On Error Resume Next
Range("A3", Range("A3").End(xlToRight)).Select
For Each Cell In Selection.Cells
myCell = Right(Cell, Len(Cell) - (InStrRev(Cell, " ") - 1))
MsgBox myCell ' just to be sure the word is found
If myCell Like word Then
Selection.Cells.Bold = False
Else
Delete.Column
End If
Next Cell
Next
I can find&identify the word and "If" works fine so far, just nothing happens to the selected cell and the column wasn't deleted.
With some changes I can only delete the entire row but it isn't what I need.
Any help appriciated.
Thx in advance.

Answer 1

This should work, but I'd recommend cleaning up the syntax. I've removed the code where you're selecting ranges (there's lots of info online about why you shouldn't do this).
An array is created to find the last word and that's tested against the search value.
Sub Test()
Dim examinee As Variant
Dim cell As Range
Dim word As String
Dim myCell As String
Dim arr() As String
Dim strLastWord As String
'How Many Sheets Should We Loop?
examinee = InputBox("How many sheets?")
'What Word Are We Searching For?
word = InputBox("Looking for?")
'Loop Sheets
For A = 1 To examinee
'Loop Cells In Row 3
For Each cell In Range("A3", Range("A3").End(xlToRight))
'Get The Value Of The Current Cell
myCell = Right(cell, Len(cell) - (InStrRev(cell, " ") - 1))
'Is It A Single Word?
If InStr(1, myCell, " ") Then
'Several Words. Create An Array Of Individual Words In The Cell
arr() = Split(myCell, " ")
'Get The Number Of The Last Word
strLastWord = arr(UBound(arr))
Else
'Single Word. Get The Word
strLastWord = myCell
End If
'Is The Last Word = The Search Word?
If strLastWord = word Then
'Yes. Make It Bold
cell.Font.Bold = True
Else
'No. Delete The Column
Columns(cell.Column).Delete
End If
Next cell
Next
End Sub

Answer 2

I think this will help you
Sub findtext()
Dim wsAkt As Worksheet
Dim i As Integer
Dim k As Integer
Dim x As Integer
Dim strWord As String
Dim intWord As Integer
'get the word
strWord = Application.InputBox("Looking for?")
'length of word
intWord = Len(strWord)
'loop through all worksheets
For i = 1 To ThisWorkbook.Worksheets.Count
'variable for selected worksheet
Set wsAkt = ThisWorkbook.Worksheets(i)
'get how many columns are in row 3
x = wsAkt.Cells(3, wsAkt.Columns.Count).End(xlToLeft).Column
'loop through row 3 columns
For k = 1 To x
'if last Word in cell = the word then it has to have the same length
If Right(wsAkt.Cells(3, k), intWord) <> strWord Then
'delete selected column
wsAkt.Columns(k).Delete
End If
Next k
Next i
End Sub
(Its not tested)