Сокращение, оптимизация, замена кода - VBA

Формулировка задачи:

Здравствуйте. Столкнулся с проблемой Compile error: Procedure too large. Помогите сократить код иди дайте другую идею для реализации задуманого. Задумано так: в открытом документе, в первой попавшей таблице, в каждой строке 4-го столбца выделяется текст ячейки. Делается проверка выделенного текста с заданным текстом, если удовлетворяет - переменной присвоить соответственное значение. Получается 500 строк If Selection.Execute(FindText:=" ", MatchCase:=True, Wrap:=wdFindStop, MatchWildcards:=True) = True Then переменная = " "

Sub project0 ()
Dim obl1, obl2, obl3 As String
For Row = 2 To ActiveDocument.Tables(1).Rows.Count
Selection.Find.ClearFormatting
ActiveDocument.Tables(1).Columns(4).Cells(Row).Select
If Selection.Find.Execute(FindText:="м.*@Ладижин", MatchCase:=True, Wrap:=wdFindStop, MatchWildcards:=True) = True Then oblrow = "02373"
If Selection.Find.Execute(FindText:="м.*@Вінниц", MatchCase:=True, Wrap:=wdFindStop, MatchWildcards:=True) = True Then oblrow = "02383"
If Selection.Find.Execute(FindText:="м.*@Нововолинськ", MatchCase:=True, Wrap:=wdFindStop, MatchWildcards:=True) = True Then oblrow = "03203"
If Selection.Find.Execute(FindText:="м.*@Марган", MatchCase:=True, Wrap:=wdFindStop, MatchWildcards:=True) = True Then oblrow = "04213"
Next Row
End Sub

Решение задачи: «Сокращение, оптимизация, замена кода»

textual
                            Листинг программы 
                        

                            dim a(1 to 4, 1 to 2) as String
a(1,1)="Ладижин": a(1,2)="02373"
a(2,1)="Вінниц": a(2,2)="02383"
a(3,1)="Нововолинськ": a(3,2)="03203"
a(4,1)="Марган": a(4,2)="04213"
For iRow = 2 To ActiveDocument.Tables(1).Rows.Count
Selection.Find.ClearFormatting
for j=1 to 4
if instr(1,"" & (ActiveDocument.Tables(1).Columns(4).Cells(iRow)),a(j,1))>0 and  instr(1,"" & (ActiveDocument.Tables(1).Columns(4).Cells(iRow)),"Жовтнев")>0 and instr(1,"" & (ActiveDocument.Tables(1).Columns(4).Cells(iRow)),"м.")>0 then oblrow = a(j,2): Exit for
next j
next iRow
                        