Track Cell Changes

[jamescooper]

Hello,

So I am looking for the most efficient way using VBA worksheet_change to track cell changes and populate into a column.

So say I have cells A1 and A2, when either of them change I want to populate it into another column, say C and D.

I will have quite a few of these so looking for the most efficient code under this:

Private Sub Worksheet_Change(ByVal Target As Range)

Many thanks.

 

[jamescooper]

Yes that is right, although both are copied regardless of which changes, either A1 or A2.

So if A1 changes from Apple to Pear and A2 remains constant, it will still copy them to the next available row in columns C and D.

Make sense?

 

[My Aswer Is This]

So if A1 Changes or A2 changes the script runs. Changing values in column C and D

Looks like to me you will have duplicates in column C and D

The second you make the change column C and D will change

So even if A2 does not change the value in column D will change

Your sure that is what you want?

So you may have Apple in C1 and C2

 

[jamescooper]

Yes that is right... Although both copy A1 or A2 if either change

 

[jamescooper]

Managed to have something that works...

Private Sub Worksheet_Change(ByVal Target As Range)


Dim nR As Long


nR = WorksheetFunction.Max(2, Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row + 1)


If Not Intersect(Target, Range("A1:A2")) Is Nothing Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Range("A1").Copy Destination:=Sheets("Sheet1").Range("C" & nR)
Range("A2").Copy Destination:=Sheets("Sheet1").Range("D" & nR)


End If


End Sub

 

[My Aswer Is This]

Managed to have something that works...

Private Sub Worksheet_Change(ByVal Target As Range)


Dim nR As Long


nR = WorksheetFunction.Max(2, Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row + 1)


If Not Intersect(Target, Range("A1:A2")) Is Nothing Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Range("A1").Copy Destination:=Sheets("Sheet1").Range("C" & nR)
Range("A2").Copy Destination:=Sheets("Sheet1").Range("D" & nR)


End If


End Sub

Had to go to bed. But glad to see you found a answer some other place.

 

[jamescooper]

Just made it up combining other coding and what you had suggested so thanks.

 

[My Aswer Is This]

Just made it up combining other coding and what you had suggested so thanks.

Always glad to see users can read and understand code. This way you can learn as times goes on to do more on your own.
Take care