Возможно ли задержать код Worksheet_Change? Excel Vba

Question

Я заполняю списки выпадающих списков данных, их значения указаны в таблице.
У меня есть кнопки (эта ссылка для пользовательских форм), чтобы пользователи могли добавлять элементы в таблицу. После ввода нового значения код Worksheet_Change для листа сортирует таблицу.
Итак, если значение удалено, размер таблицы изменяется.

Но теперь моя проблема в том, что при нажатии кнопки в пользовательской форме сначала добавляется строка, которая добавляется в таблицу, а затем добавляется значение в эту строку. Перед добавлением значения Worksheet_Change уже обнаружил новую пустую строку и удалил ее.
Можно ли задержать это, или кто-то знает лучшее решение?

Код для UserForm:

Private Sub butAddProject_Click() 

    Dim listSheet As Worksheet 
    Dim listTable As listObject 
    Dim newRow As ListRow 
    Dim ProjectName As String 

    ProjectName = txtAddProject.Text 

    Set listSheet = Sheets("Projects-Tasks") 
    Set listTable = listSheet.ListObjects(1) 

    If ProjectName <> "" Then 
     Set newRow = listTable.ListRows.Add 
     newRow.Range(1, 1).Value = ProjectName 
    Else 
     MsgBox "Enter a project name first!" 
    End If 

    txtAddProject.Text = "" 
    formAddProject.Hide 

End Sub 

И, наконец, код Worksheet_Change:

Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim ws As Worksheet 
    Dim strList As String 
    Set ws = Sheets("Projects-Tasks") 
    strList = Cells(2, Target.Column).listObject.Name 

    If strList <> "" Then 
     Application.ScreenUpdating = False 
      With ListObjects(strList).Sort 
       .SortFields.Add _ 
        Key:=Cells(3, Target.Column), _ 
        SortOn:=xlSortOnValues, _ 
        Order:=xlAscending 
       .Header = xlYes 
       .MatchCase = False 
       .Orientation = xlTopToBottom 
       .SortMethod = xlPinYin 
       .Apply 
      End With 

     With ws.ListObjects(strList) 
      .Resize .DataBodyRange.CurrentRegion 
     End With 

    End If 

    Application.ScreenUpdating = True 

End Sub 

спасибо заранее!

Answer 1

Turn событие прочь при добавлении новой строки:

If ProjectName <> "" Then 
    application.enableevents = False 
    Set newRow = listTable.ListRows.Add 
    application.enableevents = True 
    newRow.Range(1, 1).Value = ProjectName 
Else 

Я предполагаю, что вы все еще хотите, чтобы отсортировать, когда вы добавляете новое значение, так что я сбросить события до линии, которая добавляет новое значение.

Answer 2

Private Sub butAddProject_Click() 

    Dim listSheet As Worksheet 
    Dim listTable As listObject 
    Dim newRow As ListRow 
    Dim ProjectName As String 

    Application.EnableEvents=False 

    ProjectName = txtAddProject.Text 

    Set listSheet = Sheets("Projects-Tasks") 
    Set listTable = listSheet.ListObjects(1) 

    If ProjectName <> "" Then 
     Set newRow = listTable.ListRows.Add 
     newRow.Range(1, 1).Value = ProjectName 
    Else 
     MsgBox "Enter a project name first!" 
    End If 

    txtAddProject.Text = "" 
    formAddProject.Hide 

    Application.EnableEvents=True 


End Sub