Обновление части листа

[Флина]

Добрый день!

У меня есть большой файл (24914 строк excel 2003). Его заполняют разные отделы.
У меня есть колонка "comment". В ней выпадающий писок.
Если выбираешь значение "Сомнительный долг" то в столбце "Status old debts" выпадает один список, если "оплата/зачет" то другой список.
Это сделано для того, чтобы отделы не ставили противоречащие друг другу данные.
Вопрос в том, что всякий раз, когда выбираешь какое-то значение, курсор бегает по всем ячейкам (24914) . А как сделать так, чтобы он не бегал?
Вот код, котрый у меня получился.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As String
Dim AM As String
Dim i As Integer
For i = 1 To 24914
AM = cells(1 + i, 46).value
P = cells(1 + i, 41).value
Select Case P
Case "Сомнительный долг"
cells(i + 1, 46).Select
With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=$BH$12:$BH$15"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True '
        End With

Case "Оплата/зачет"
cells(i + 1, 46).Select
With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=$BH$19:$BH$20"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True '
        End With
 End Select
Next i
End Sub

[Флина]

Вот файл.

Сжатая ZIP-папка.zip

[EducatedFool]

Я не понял, после изменения ячейки в столбце comment, вам надо изменить выпадающий список ВО ВСЕХ ячейках на листе, или только в ОДНОЙ ячейке - в той же строке, где был изменён comment?

Я бы вам посоветовал такой вариант: (для той строки, где был изменён comment)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Or Target.Column <> 41 Then Exit Sub
    
    With Target.Offset(, 5).Validation
        .Delete
        Select Case Target
            Case "Сомнительный долг"
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                     xlBetween, Formula1:="=$BH$12:$BH$15"
            Case "Оплата/зачет"
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                     xlBetween, Formula1:="=$BH$19:$BH$20"
        End Select
    End With
End Sub

[Флина]

Спасибо большое