Optimere lille visual basic kode til brug i excel

Jeg har følgende kode, bestående af:
1: En calender der indsættes når jeg klikker i en defineret celle
2: Data der fyldes i 4 celler når en celle i kolonnen A udfyldes.

Punkt 2 forekommer meget langsom, idet den indsætter værdien celle for celle når en celle i kolonnen A udfyldes.
Kan dette sammenskrives, så det er hurtigere?


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'check cells for desired format to trigger the calendarfrm.show routine
    'otherwise exit the sub
    Dim DateFormats, DF
    DateFormats = Array("dd/mm/yy", "mmmm d yyyy")
    For Each DF In DateFormats
        If DF = Target.NumberFormat Then
            If CalendarFrm.HelpLabel.Caption <> "" Then
                CalendarFrm.Height = 191 + CalendarFrm.HelpLabel.Height
            Else: CalendarFrm.Height = 191
                CalendarFrm.Show
            End If
        End If
    Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
       
    With Target
            If .Count > 1 Then Exit Sub
            If Not Intersect(Range("A2:A999"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    .Offset(0, 3).ClearContents
                Else
                    With .Offset(0, 3)

                        .Value = "(N/A)"
                    End With
                End If
                Application.EnableEvents = True
            End If
        End With
       
    With Target
            If .Count > 1 Then Exit Sub
            If Not Intersect(Range("A2:A999"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    .Offset(0, 4).ClearContents
                Else
                    With .Offset(0, 4)

                        .Value = "(N/A)"
                    End With
                End If
                Application.EnableEvents = True
            End If
        End With
       
    With Target
            If .Count > 1 Then Exit Sub
            If Not Intersect(Range("A2:A999"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    .Offset(0, 5).ClearContents
                Else
                    With .Offset(0, 5)
                        .NumberFormat = "dd-mm-yy"
                        .Value = Date
                    End With
                End If
                Application.EnableEvents = True
            End If
        End With
       
    With Target
            If .Count > 1 Then Exit Sub
            If Not Intersect(Range("A2:A999"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    .Offset(0, 10).ClearContents
                Else
                    With .Offset(0, 10)

                        .Value = "Not Started"
                    End With
                End If
                Application.EnableEvents = True
            End If
        End With
       
    With Target
            If .Count > 1 Then Exit Sub
            If Not Intersect(Range("A2:A999"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    .Offset(0, 11).ClearContents
                Else
                    With .Offset(0, 11)

                        .Value = 3
                    End With
                End If
                Application.EnableEvents = True
            End If
        End With
       
       
    End Sub