Forum Discussion

falloute's avatar
falloute
Copper Contributor
Jul 22, 2020
Solved

When a value changes it then is transfered to another sheet but also retains each change

So if N11 from sheet1 changes then it's posted to A2 in sheet2 but then next input from N11 would go to A3 and so on.
excel
Formulas and Functions
Macros and VBA
  • JMB17's avatar
    JMB17
    Jul 23, 2020

    falloute 

     

    If N11 is a formula and you believe the calculate event will work better for you, then maybe this is closer to what you want.

     

    Private Sub Worksheet_Calculate()
     Dim source As Range
     Dim lastCell As Range
     
     Set source = Me.Range("N11")
     
     With Worksheets("Sheet2")
          Set lastCell = .Cells(.Rows.Count, 1).End(xlUp)
     End With
     
     If lastCell.Value <> source.Value Or (IsEmpty(lastCell) Xor IsEmpty(source)) Then
          lastCell.Offset(1, 0).Value = source.Value
     End If
     
     Set source = Nothing
     Set lastCell = Nothing
     
End Sub
NikolinoDE's avatar
NikolinoDE
Gold Contributor
Jul 23, 2020

Just put it like this ... in case it should get more complicated ... although the answer from JMB17 is the quickest and easiest.
Fresh from the internet address ... with a little adjustment it could work ...


In the class module "This workbook"

Private Sub Workbook_Open()
'Start der Control-Routine
Ctrl_Each_Minute
End Sub

'In ein Modul
Public CtrlValue, Mldg As Long


Sub Control_each_Minute()
'Variablen erstellen
Dim Qe As Integer
Dim Msg As String, wks As String, myCell As String
'Prepare variables
Msg = ""
wks = "Tabelle1" ''Table in which the value is
myCell = "A1" 'Cell to be checked
'The first time the variable is started, it must be checked and filled
If IsEmpty(CtrlValue) Then
CtrlValue = Worksheets(wks).Range(myCell)
Mldg = 0
End If
'Start for the next check
Application.OnTime Now() + TimeValue("00:01:00"), "control_each_Minute"
'Message when the value has been changed
If Worksheets(wks).Range(myCell) <> CtrlValue Then
Msg = "Der Kontrollwert " & CtrlValue & " hat sich geändert." & Chr$(13)
Msg = Msg & " Would you like the new value " & Worksheets(wks).Range(myCell) & " as a control value? "
If Mldg > 0 Then
Qe = MsgBox(Msg, vbCritical + vbYesNo + vbDefaultButton1, "ACHTUNG: " & Mldg & ". ÄÄnderungsinformation")
If Qe = 6 Then
'Takeover of the new value as a control value
CtrlValue = Worksheets(wks).Range(myCell)
'Reset Counters
Mldg = 0
Exit Sub
End If
'add up the Counters
Mldg = Mldg + 1
Else
Qe = MsgBox(Msg, vbCritical + vbYesNo + vbDefaultButton1, " ATTENTION: Change information ")
If Qe = 6 Then
'Take over value as a Control value
CtrlValue = Worksheets(wks).Range(myCell)
'ResetCounters
Mldg = 0
Exit Sub
End If
'Add up Counters
Mldg = Mldg + 1
End If
End If
End Sub

Enjoy Excel

Nikolino

Resources