Check if there is a change in cell

Good day Excel Gurus,

I have the working VBA code below but I need some revision. The code below checks every cell if there is a change. Example, If I made change on cell “D9”, it will ask “Do you want to save changes…?” and also same with “D10”, “D11”, and so on.

What revision I want is when you reach “D42”, or when I exit on the loop that the only time it will check if there are changes made on the sheet.

Any help would be appreciated.

Thank you.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
Application.DisplayAlerts = False

    Dim historyWks As Worksheet
    Dim inputWks As Worksheet
    Dim rngA As Range
    Dim rngDE As Range

    Dim lRec As Long
    Dim lRecRow As Long
    Dim lLastRec As Long
    Dim lastRow As Long
    Dim lCellsDE As Long
    Dim lColHist As Long
    Dim LRsp As Long

If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub

      If Not Intersect(Target, Range("D9:D42")) Is Nothing Then
        Application.EnableEvents = False
         Beep
         LRsp = MsgBox("Do you want to Save Changes made? ", vbQuestion + vbYesNo, "CHANGES")
        If LRsp = vbYes Then
          UpdateLogRecord
        Else
          ClearDataEntry
        End If 
    End If 

  On Error GoTo 0

    Set rngA = ActiveCell
    Set inputWks = Worksheets("Input")
    Set historyWks = Worksheets("dBase")
    Set rngDE = inputWks.Range("OrderEntry")
    lCellsDE = rngDE.Cells.Count
    lColHist = 3

Application.EnableEvents = False
    Select Case Target.Address
      Case Me.Range("OrderSel").Address
        Me.Range("CurrRec").Value = Me.Range("SelRec").Value
      Case Me.Range("Code").Address
        If Range("CheckID") = True Then
          Me.Range("OrderSel").Value = Me.Range("Code").Value
          Me.Range("CurrRec").Value = Me.Range("SelRec").Value
        Else
          Me.Range("OrderSel").ClearContents
          Me.Range("CurrRec").Value = 0
          Me.Range("ClearVar").ClearContents
        Application.EnableEvents = True
        End If
      Case Else
        GoTo exitHandler
    End Select
    
    With historyWks
      lastRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row - 1
      lLastRec = lastRow - 1
    End With

    With historyWks
          lRec = inputWks.Range("CurrRec").Value
      If lRec > 0 And lRec <= lLastRec Then
          lRecRow = lRec + 1
          .Range(.Cells(lRecRow, lColHist), .Cells(lRecRow, lCellsDE)).Copy
          rngDE.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
          rngA.Select
      End If
    End With
Application.EnableEvents = True
exitHandler:
Application.ScreenUpdating = True
Application.DisplayAlerts = True

Exit Sub
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub