Sub findString()
Dim myLastRow As Integer
Dim myRow As Integer
myLastRow = Sheet("Sheet1").UsedRange.Rows.Count 'Change the name of the sheet here
myRow = 2
Do Until myRow = myLastRow
If Sheets("Sheet1").Cells(myRow, 1) = "Apple" Then 'Change the strings you want to find and input
Sheets("Sheet1").Cells(myRow, 6) = "Boy"
End If
myRow = myRow + 1
Loop
End Sub
If Sheets("Sheet1").Cells(myRow, 1) = "Apple" Then 'Change the strings you want to find and input
If Sheets("Sheet1").Cells(myRow, 1) LIKE "*Apple*" Then 'Change the strings you want to find and input