Excel - Capture value from cell and copy to a table

[liamm]

Hi,

I have a spreadsheet with a cell (D13) which AVERAGES a column of data. This data column is updated frequently but not on a routine basis. I want to capture the value from the AVERAGE cell(D13) and copy the value and current date to a table on another sheet each time the data column is updated and the spreadsheet saved (resulting in a table of values and dates of each time the spreadsheet is saved.
So far I have the following code but this only works when the cell(D13) is updated manually which is no good for my needs.
Can anyone help please?

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$13" Then
With Sheets("CaptureSheet").Range("A65536").End(xlUp)
.Cells(2, 1) = Target
.Cells(2, 2) = Now
.Range("A1:B1").EntireColumn.AutoFit
End With
End If
End Sub

For info, in case there is a better way to do this: what I am trying to achieve is that I am trying to produce a graph of progress for an activity. I have a list of activities and each activity has a progress number assigned to it (0 to 100%). I am using an AVERAGE calculation to average the overall % completion of all of the activities. I then need to plot this progress on a graph to show the progress against timescale visually.

Many thanks,
Liam
​

If you can help, GREAT
If I can help, EVEN BETTER

 

[SkipVought]

Hi,

This data column is updated frequently

How is this column updated? I'd use the Worksheet_Change event to run your procedure.

BTW, your formula cell will not indicate a change: only the formula RANGE.

Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, [YourRangToAverage]) Is Nothing Then
'.....

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[liamm]

Hi Skip, sorry I'll try and explain as much as I can with my little knowledge..
Regarding how the data is updated - this is done manually. Each day, or numerous times per day, a user open the sheet and records their progress against their own activity in %.
I think I have found the info I need which will capture manual and automatic cell updates:

Private Sub Worksheet_Calculate()
Dim x As Variant, r As Range
'checks for changed values in the cell
Set r = Sheets("Capture sheet").Range("A65536").End(xlUp)
If Range("D13").Value <> r.Value Then 'change occurred
With r
.Cells(2, 1).Value = Range("D13").Value
.Cells(2, 2).Value = Now
.Range("A1:B1").EntireColumn.AutoFit
End With
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$13" Then
With Sheets("Capture sheet").Range("A65536").End(xlUp)
.Cells(2, 1).Value = Target.Value
.Cells(2, 2).Value = Now
.Range("A1:B1").EntireColumn.AutoFit
End With
End If
End Sub

If you can help, GREAT
If I can help, EVEN BETTER