Hi Team

I have this code and it makes my worksheet load slowly. Data from user form is being populated into a row very slowly. I have the code added to this post.

File has 10 tabs with many Vlookup from one workbook to other. Kindly help me to make the loading process faster

code as follows
Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim rowNum As Integer
    rowNum = InputBox("Enter Row Number where you want to add a row:", Title:="Add New Row")
    If Len(rowNum) = 0 Then
        MsgBox ("You have not entered a row number.")
        Exit Sub
    End If
    Rows(rowNum).Insert Shift:=xlDown
    Cells(rowNum, 1).Select
    'UserForm1.Show
    With Application.ActiveSheet
        'Dim Valid As Hyperlink
        .Hyperlinks.Add _
        Anchor:=.Cells(rowNum, Range("AA1:AA5000").Column), _
        Address:="", _
        SubAddress:=.Cells(rowNum, Range("AA1:AA5000").Column).Address, _
        ScreenTip:="Edit This Row", _
        TextToDisplay:="Edit"
        
        .Hyperlinks.Add _
        Anchor:=.Cells(rowNum, Range("AB1:AB5000").Column), _
        Address:="", _
        SubAddress:=.Cells(rowNum, Range("AB1:AB5000").Column).Address, _
        ScreenTip:="Delete This Row", _
        TextToDisplay:="Delete"
    End With

    UserForm1.Show
     Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
'Author - Jason Kearney, 2/23/18
Private Sub ResetEvents()
    'Run this if Worksheet_Change does not end before resetting events.
    Application.EnableEvents = True
    MsgBox "Events Reset.", vbOKOnly
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim KeyCells As Range
    Application.EnableEvents = False
    
    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("N3:N5000")
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

        'Identify the current Row
        Dim ThisRow As Integer
        ThisRow = Target.row
        Dim ThisCol As Integer
        ThisCol = Target.Column
        Dim ThisLevel As Integer
        Dim ThisAction As String
        Dim ThisItemName As String
        Dim FindColName As String
        'Record the value for changing
        ThisAction = Target.Text
        'Find the current BOM Level
        Dim ShowErrs As Boolean
        'First Pass - Notify if errors.
        ShowErrs = True
        ThisLevel = RowBOMLevel(ThisRow, ShowErrs)
        Dim CursorRow As Integer
        CursorRow = ThisRow + 1
        
        'Find the "Comments" column
        Dim CommentsCol As Integer
        Dim UserComments As String
        Dim AffectedComment As String
        Dim ItemNameCol As Integer
        FindColName = "Comments"
        CommentsCol = FindColumnByName(FindColName)
        If CommentsCol <> -1 Then
            'Prompt user for change comments
            If UCase(ThisAction) <> "CHANGE" Then
                UserComments = InputBox("Reason for Changes:", "Add Comments...")
                If UserComments = vbNullString Then
                    Cells(ThisRow, ThisCol).Value = ""
                    MsgBox "Error: Please Reset Action Manually", vbOKOnly
                    GoTo CancelledChange
                End If
            Else
                UserComments = ""
            End If
            Cells(ThisRow, CommentsCol).Value = UserComments
            
            'Identify changed item-name for marking comments of affected rows
            FindColName = "Part Number"
            ItemNameCol = FindColumnByName(FindColName)
            If ItemNameCol <> -1 Then
                ThisItemName = Cells(ThisRow, ItemNameCol).Text
                If UCase(ThisAction) = "REMOVE" Then
                    AffectedComment = "Parent BOM removed: " & ThisItemName
                Else
                    AffectedComment = ""
                End If
            End If
        End If
        
        
        'Second pass and beyond, exceptions occur upon end conditions met
        ShowErrs = False
        'Update all sub-level BOM items to the same status
        Do While (RowBOMLevel(CursorRow, ShowErrs) > ThisLevel And RowBOMLevel(CursorRow, ShowErrs) > -1)
            'Convert value to match
            Cells(CursorRow, Target.Column).Value = Target.Text
            'Mark/Unmark Comments If REMOVEd/CHANGEd
            If (CommentsCol <> -1 And ItemNameCol <> -1) Then
                Cells(CursorRow, CommentsCol).Value = AffectedComment
            End If
            CursorRow = CursorRow + 1
        Loop
        
        'If Status is not "CHANGE", Go up the BOM tree and mark required parent-BOM changes
        If UCase(ThisAction) <> "CHANGE" Then
            AffectedComment = "Child Component Changed: " & ThisItemName
            Dim TmpAffComnt As String
            Dim CursorLevel As Integer
            CursorLevel = ThisLevel - 1
            CursorRow = ThisRow - 1
            Do While (CursorLevel > 0 And CursorRow > 0)
                If RowBOMLevel(CursorRow, ShowErrs) = CursorLevel Then
                    If UCase(Cells(CursorRow, ThisCol).Text) = "CHANGE" Then
                        Cells(CursorRow, ThisCol).Value = "CHANGE"
                        If CommentsCol <> -1 Then
                            Cells(CursorRow, CommentsCol).Value = AffectedComment
                        End If
                    Else
                        If CommentsCol <> -1 Then
                            TmpAffComnt = Cells(CursorRow, CommentsCol).Text & ", " & ThisItemName
                            Cells(CursorRow, CommentsCol).Value = TmpAffComnt
                        End If
                    End If
                    CursorLevel = CursorLevel - 1
                End If
                CursorRow = CursorRow - 1
            Loop
        End If
CancelledChange:
        'MsgBox "Cell " & Target.Address & " has changed."
        Application.EnableEvents = True
    End If
     Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Private Function FindColumnByName(Name As String) As Integer
'Function searches the top row of the sheet for matching column header name
        Dim CurrColumnName As String
        Dim CursorCol As Integer
        CursorCol = 0
        Do While (UCase(CurrColumnName) <> UCase(Name) And CursorCol < 100) '<100 : End at some point
            CursorCol = CursorCol + 1
            CurrColumnName = Cells(1, CursorCol).Text
        Loop
        If UCase(CurrColumnName) <> UCase(Name) Then
            FindColumnByName = -1
        Else
            FindColumnByName = CursorCol
        End If
End Function

Private Function RowBOMLevel(R As Integer, ShowErrMsgs As Boolean) As Integer
Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim ErrMsgStr As String
    Dim LevelVal As String
    LevelVal = ""
    Dim Level As Integer
    For c = 3 To 13 'Plan for 10 Levels Maximum
        'If Not (IsEmpty(Cells(R, C))) Then
        If (Cells(R, c).Text <> "" And LevelVal = "") Then
            LevelVal = Cells(R, c).Text
        End If
    Next c
    If LevelVal = "" Then GoTo NoLevel
    
    On Error GoTo CannotConvert
    Level = CInt(LevelVal)
    RowBOMLevel = Level
    GoTo Complete
CannotConvert:
    If ShowErrMsgs Then
        ErrMsgStr = "Cannot convert level " & LevelVal & " to numeric BOM Level."
        MsgBox ErrMsgStr, vbOKOnly
    End If
    RowBOMLevel = -1
    GoTo Complete
NoLevel:
    If ShowErrMsgs Then
        ErrMsgStr = "No Level Data Found."
        MsgBox ErrMsgStr, vbOKOnly
    End If
    RowBOMLevel = -1
Complete:
 Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Function