How to speed up this code

[LuckyDPR]

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim NewRow As ListRow
     Dim VarName As String
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    If Not (Application.Intersect(Target, Range("HHPTable[Model]")) Is Nothing) Then
        Application.Calculation = xlCalculationManual
        With Target
                If Worksheets("VARSheet").Range("VARTable[Model]").Find(What:=Target.Value) Is Nothing Then
                        VarName = Application.InputBox("Please Input VAR Code:", "VAR Code")
                        Set NewRow = Worksheets("VARSheet").ListObjects("VARTable").ListRows.Add       'this statement is taking very long
                        With NewRow
                            .Range(Worksheets("VARSheet").Range("VARTable[Model]").Column) = Target.Value
                            .Range(Worksheets("VARSheet").Range("VARTable[Code]").Column) = VarName
                        End With
                End If
        End With
        Application.Calculation = xlCalculationAutomatic
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Everything is fine and working but statement marked as bold is taking too much time, is there any other speedy work around to get the same result

 

[Jeffrey Mahoney]

If your code is taking a long time to add a new row to a table, then maybe you should either have plenty of blank rows in the table to ad more data.

 

[Peter_SSs]

@LuckyDPR
If you want to apply your own formatting within vba code (eg Bold), use the 'RICH' code tags not the standard VBA code tags. I have fixed that for you this time.

With my small dummy sample file I could not replicate any time delay. However, you could give this a try to see if it makes any difference for you.
The commented out lines are replaced with the blue ones.

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim NewRow As ListRow
     Dim VarName As String
     Dim n As Long

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    If Not (Application.Intersect(Target, Range("HHPTable[Model]")) Is Nothing) Then
        Application.Calculation = xlCalculationManual
        With Target
                If Worksheets("VARSheet").Range("VARTable[Model]").Find(What:=Target.Value) Is Nothing Then
                        VarName = Application.InputBox("Please Input VAR Code:", "VAR Code")
'                        Set NewRow = Worksheets("VARSheet").ListObjects("VARTable").ListRows.Add  'this statement is taking very long
'                        With NewRow
'                            .Range(Worksheets("VARSheet").Range("VARTable[Model]").Column) = Target.Value
'                            .Range(Worksheets("VARSheet").Range("VARTable[Code]").Column) = VarName
'                        End With
                        n = Sheets("VARSheet").Range("VARTable").Rows.Count + 1
                        Sheets("VARSheet").Range("VARTable[Model]").Cells(n).Value = Target.Value
                        Sheets("VARSheet").Range("VARTable[Code]").Cells(n).Value = VarName
                End If
        End With
        Application.Calculation = xlCalculationAutomatic
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[LuckyDPR]

@Peter_SSs :
at present I working towards solution suggested by @Jeffrey Mahoney, by adding blank or dummy row entries in advance then later filling them using the sub, it seems to me faster way, cause If I manually add/delete a row to/from the table, then also it takes too much time

 

[LuckyDPR]

If your code is taking a long time to add a new row to a table, then maybe you should either have plenty of blank rows in the table to ad more data.

Used your suggestion, not instantaneous but much faster