Excel VBA to repeat founding - excel

Question

Goal:
Search Sheet1 for keywords in column 18 (keywords:case,etc.)
Once keyword is found, offset (0,-11)
enter the given value C1008 in respective cell.
and repeat the same till it completes full column (about 1500 rows)
I am not able to perform 4th step.
And I need multiple keywords to search and perform the same steps.
Program:
Sub RCIM()
Dim ws As Worksheet
Dim aCell As Range
Range("A1").Select
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
Set aCell = .Columns(18).Find(What:="case", LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
aCell.Offset(0, -10).Value = "C1008"
Else
MsgBox "Not Found"
End If
End With
End Sub

Answer 1

If you want just to repeat your code use a loop statement like this:
Sub RCIM()
Dim ws As Worksheet
Dim aCell As Range
DIM isTimetoExit As Boolean
Dim currentRow As Long 'Counter of Rows
Dim KeyWord as String
Range("A1").Select
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
isTimetoExit = False
currentRow = 1 'If you start from row 1
KeyWord = "case"
DO
'
Set aCell = .Columns(18).Find(What:=KeyWord, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
aCell.Offset(0, -10).Value = "C1008"
Else
MsgBox "Not Found"
End If
'
' Whit a condition go out of loop
isTimetoExit = NOT (Trim(.Cells(currentRow, 1).Value & "") = "")
If (isTimetoExit) THEN EXIT DO
'Go for next row
currentRow = currentRow + 1
' And set the keyword to your new value;
KeyWord = "next case" 'But I don't know where are those KeyWords stroes !?
LOOP
End With
End Sub