Макрос поиска совпадений в тексте - VBA

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

Всем доброго времени суток! Пишу с просьбой помочь написать макрос для поиска совпадений в ячейках из списка. Пример во вложении. Нужно, чтобы макрос проверял ячейку А1 на литсе 1, искал совпадений из списка на листе 2 и в ячейку B1 листа 1 вставлял значения ячейки B1 листа 2. Есть еще пару нюансов, т.к. файл будет вестись в течении года, возможно ли сделать так, чтобы макрос выполнялся не по нажатию кнопок каких-либо, а постоянно? Я представляю сколько он в таком случае будет думать, т.к. к к концу года там накапливается порядка 5-6 тысяч строк, в связи с этим возникает еще один вопрос, возможно ли сделать так: после того как мы внесли значение A1 на листе 1, и макрос проставил нужное значение в B1, то в следующий раз при открытии файла, он больше не трогал ячейку А1, и начинал выполняться только когда допустим в A2 мы внесли значение и так далее. Так сказать разовая процедура... Заранее большое спасибо!

Решение задачи: «Макрос поиска совпадений в тексте»

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

                            Private Sub Worksheet_Change(ByVal Target As Range)
Dim arr(), i%
Application.EnableEvents = False 'отключает слежение за событиями
If Target.Count > 1 Then Exit Sub 'если изменено больше 1 ячейки то выход из кода
If Target.Column <> 1 Then Exit Sub 'если измененная ячейка в первом столбце то
arr = Sheets("Лист2").Range("A1:B100").Value 'заносим данные из диапазона A1:B100 листа2 в двумерный массив
For i = 1 To UBound(arr) 'цикл от 1 до 100 (100 размерность массива)
' если в тексте содержится текст из итого значения массива то в ячейку правее на 1 от измененной вносит значение
' итого массива второго столбца
 If UCase(Target.Value) Like "*" & UCase(arr(i, 1)) & "*" Then Target.Offset(0, 1).Value = arr(i, 2): Exit For
Next
Application.EnableEvents = True 'включаем слежение за событиями
End Sub
                        