title: Workbook slow and crashing due to VBA code? Anyway to stop this/speed this up?
body: <p>I have the below code in my worksheet.
  The code causes the spreadsheet to works slow and crash and it also takes ages to open. I am brand new to VBA and may not be coding this correctly. Is there a better way of structuring my code to prevent this from happening?</p>
  
  <pre><code>Option Explicit
  Option Compare Text
  
  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  On Error GoTo Message
  ActiveSheet.DisplayPageBreaks = False
   If Target.Address = "$K$3" Then
      If Range("A" &amp; Rows.Count).End(xlUp).Row &lt; 5 Then
      Range("A5").Select
      Else
      Range("A" &amp; Rows.Count).End(xlUp).Offset(1, 0).Select
      End If
      End If
  
      If Target.Address = "$I$3" Then
      If Range("A" &amp; Rows.Count).End(xlUp).Row &lt; 5 Then
      Range("A5").Select
      Else
      Range("A9").Select
      End If
      End If
  
  
       If Target.Address = "$N$2" Then
      If Range("A" &amp; Rows.Count).End(xlUp).Row &lt; 5 Then
          Range("A5").Select
      Else
          Range("A7").Select
      End If
      End If
  
  
         'Clear Search Box
      If Target.Address = "$N$3:$O$3" Then
      Target.Value = ""
      End If
  
  
  
  
  Exit Sub
  
  Message:
  Application.DisplayAlerts = False
  Exit Sub
  
  End Sub
  
  
  Private Sub Worksheet_Change(ByVal Target As Range)
  On Error GoTo Message
  On Error Resume Next
  
  ActiveSheet.DisplayPageBreaks = False
  
  
  
  'Insert Depot Memo Data for user
   Dim oCell As Range, targetCell As Range
      Dim ws2 As Worksheet
      On Error GoTo Message
      If Not Intersect(Target, Range("B:B")) Is Nothing Then ' &lt;-- run this code only if a value in column I has changed
          If Not GetWb("Depot Memo", ws2) Then Exit Sub
  
          With ws2
              For Each targetCell In Target
                  Set oCell = .Range("J1", .Cells(.Rows.Count, "J").End(xlUp)).Find(What:=targetCell.Value, LookIn:=xlValues, LookAt:=xlWhole)
                  If Not oCell Is Nothing Then
                      Application.EnableEvents = False
  
                      'Set Format of cell
                      targetCell.Font.Name = "Arial"
                      targetCell.Font.Size = "10"
  
                      With targetCell.Borders(xlEdgeLeft)
                      .LineStyle = xlContinuous
                      .Color = RGB(192, 0, 0)
                      .Weight = xlMedium
                      End With
  
                      With targetCell.Borders(xlEdgeRight)
                      .LineStyle = xlContinuous
                      .Color = RGB(192, 0, 0)
                      .Weight = xlMedium
                      End With
  
                      With targetCell.Borders(xlEdgeTop)
                      .LineStyle = xlContinuous
                      .Color = RGB(191, 191, 191)
                      .Weight = xlThin
                      End With
  
                      With targetCell.Borders(xlEdgeBottom)
                      .LineStyle = xlContinuous
                      .Color = RGB(191, 191, 191)
                      .Weight = xlThin
                      End With
  
  
                      targetCell.Offset(0, -1).Value = Now()
                      targetCell.Offset(0, 1).Value = oCell.Offset(0, 1)
                       targetCell.Offset(0, 2).Value = oCell.Offset(0, -2)
                       targetCell.Offset(0, 3).Value = oCell.Offset(0, -7)
                      Application.EnableEvents = True
                  End If
              Next
          End With
      End If
  
  
  
  
  
   'Prompt missed on sale
      If Not Intersect(Target, Range("N:N")) Is Nothing And ActiveCell.Value = "Issue Complete" Then
      If Target.Cells.Count &lt; 8 Then
      Dim MSG1 As Variant
  
      MSG1 = MsgBox("Did Item Miss On-Sale?", vbYesNo, "Feedback")
      If MSG1 = vbYes Then
      Range("O" &amp; ActiveCell.Row).Value = "Yes"
      Else
      Range("O" &amp; ActiveCell.Row).Value = "No"
      End If
  
      Range("P" &amp; ActiveCell.Row).Value = Date - Range("A" &amp; ActiveCell.Row).Value
  
      End If
      End If
  
  
  
   If Not Intersect(Target, Range("D" &amp; ActiveCell.Row)) Is Nothing And Target.Value &lt;&gt; "" Then
   Call PhoneBook2
   End If
  
  
  
  
  
  
  'Send Email - Receipt of Issue
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  If Not Intersect(Target, Range("N:N")) Is Nothing And ActiveCell.Value &lt;&gt; "" Then
  If Target.Cells.Count &lt; 4 Then
  
  Call SendEmail0
  
  End If
  End If
  
  
  
  'Send Email - Status Change
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  If Not Intersect(Target, Range("N:N")) Is Nothing And ActiveCell.Value &lt;&gt; "" Then
  If Target.Cells.Count &lt; 4 Then
  
  Call SendEmail
  
  End If
  End If
  
  
  
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  
  
  
  
  
  
  
  Exit Sub
  
  
  
  Message:
  Application.DisplayAlerts = False
  Exit Sub
  
  End Sub
  
  
  Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
  If ActiveCell.Value = "(Turn Off Emails)" Then
  UserForm1.Show
  End If
  
  End Sub
  
  
  
  
  
  
  Function GetWb(wbNameLike As String, WS As Worksheet) As Boolean
      Dim Wb As Workbook
      For Each Wb In Workbooks
          If Wb.Name Like "*" &amp; wbNameLike &amp; "*" Then '&lt;-- check if workbook name contains "Depot Memo"
              Set WS = Wb.Worksheets(1)
              Exit For
          End If
      Next
      GetWb = Not WS Is Nothing
  End Function
  </code></pre>