Check manually change in Cell value

[gemini528]

Hello Excel Gurus,

Below is a working code but every time I change a value of a single cell it prompts that there is a change in the value ("Do you want to Save Changes made? "), The revision I want is when I reach the end (D42) or when I finish editing, it’s the only time it will ask ("Do you want to Save Changes made? "),

Any help would be appreciated.

Thank you.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    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("D8")) Is Nothing Then
        Application.EnableEvents = False
        Target = StrConv(Target, vbProperCase)
        Application.EnableEvents = True
    End If

    If Not Intersect(Target, Range("D9:D42")) Is Nothing Then
        Application.EnableEvents = False
         LRsp = MsgBox("Do you want to Save Changes made? ", vbQuestion + vbYesNo, "CHANGES")
        If LRsp = vbYes Then
          SaveChanges
        Else
          ClearEntry
        End If
    End If
  End With
    
On Error GoTo 0

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:
Exit Sub
End Sub

 

[jasonb75]

The revision I want is when I reach the end (D42) or when I finish editing

How do you define 'finish editing'?

If you only want the code to run when you edit D42 then you just need to change the range that initialises the message box, which is currently set as D9:D42, but the option for when you 'finish editing' is open to a lot of interpretation.

 

[gemini528]

What I want is when you reach D42, It's the only time it will ask to save. NOT every time you change the value of each cell. Thanks for your quick reply and sorry for the confusion. My apologies.