Forum Discussion
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.
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
9 Replies
- NikolinoDEGold Contributor
- NikolinoDEGold Contributor
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
- JMB17Bronze Contributor
Right click on sheet1 and select view code. Then, paste this event handler into the code module that appears.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Me.Range("N11").Address Then
With Worksheets("Sheet2")
.Cells(.Rows.Count, 1).End(xlUp)(2, 1).Value = Target.Value
End With
End If
End Sub- fallouteCopper Contributor
Sorry for this question, new to using code for excel and writing a personal sheet. When I click "View Sheet1 Code" I paste it in. My question is how do I get the code to run? I looked it up and I can't seem to get it to take effect.
EDIT: So I figured out this is a automatic code and it applies whenever the Worksheet_change is in effect but it appears it's not working I think, currently nothing changed in sheet2. Also I tried to look up more fixes, apparently formulas don't affect Worksheet_change but Worksheet_calculate does but when I do that I get an error when a number changes "Compile Error" Procedure declaration does not match description of event or procedure having the same name.
Thank you for the reply!
- JMB17Bronze Contributor
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