How to detect amount of changes in cell?

**defy** · 12-19-2010, 12:24 AM

Hello All!

I need a macro which quietly counts changes made to a cell and stores them even after the workbook is closed.
If the cell has been modified more then say 5 times in one day it is highlighted yellow more then 10 highlighted red. Then i need week counts and month counts (years maybe later), hence the ability to store and add amount of changes.

Any ideas? I so far got this much:

Static AncAdress As String, AncCell As Variant 
    If AncAdress <> "" Then 'for first initialization. 
        If AncCell <> Range(AncAdress) Then 

            'this detectes that the sell has been changed so i need something here to count amount of changes to which cell) 
          
            Stop 
        End If 
    End If 
    AncAdress = Target.Address 
    AncCell = Target.Value2 
End Sub

I was thinking of creating a new list called COUNTING. Say in my DATA list i changed the value of cell A2 from bob to 2. So in my COUNTING list A2 will have a value "today = 1". Hence if i decide to change its value later on in the month it will be "month = 2". also if it is shifted in DATA i.e. moved to a different location then it need to be tracked and moved in COUNTING (basically value mapping).
has any

So any ideas? I'm also open to suggestions if any ^^

**TMS** · 12-19-2010, 04:43 AM

You could use a Worksheet_Change event to monitor the cell and record the changes on a hidden worksheet in the workbook.

You could store both the date and the cell change count so that you can reinitialise daily.

Needs some thought but it's do-able

Regards

**defy** · 12-19-2010, 04:45 PM

Originally Posted by TMShucks

You could use a Worksheet_Change event to monitor the cell and record the changes on a hidden worksheet in the workbook.

You could store both the date and the cell change count so that you can reinitialize daily.

Needs some thought but it's do-able

Regards

Ill give you a visual example of what i'm trying to do

Say i have 100 pens, 200 pencils, 300 rulers...

They all get taken on a daily basis, I want to create a data sheet that if for example my outflow of pens is very high per day, then i want it to be highlighted.

Also i want see how much material is being given out per week, per month so i would know how much of what i need to purchase to keep my stock on a safe level i.e. i wont be running out pf materials all of a sudden

So i need to check how much of that particular material is being withdrawn + if it is being withdrawn in batches i.e. is there a pen with drawn once a day 5 pens once a day etc., i hope this clarifies it slightly?

Let me know if you need any more info...

Again i just came with this today so it all up in the air

P.S. its a change tracking system

ill have a look at the Worksheet_Change event...

**royUK** · 12-19-2010, 04:56 AM

Perhaps storing as a Name would be best, then it should be less likely to be deleted accidentally


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim CellChanges As Long
    If Target.Address = "$A$1" Then
        On Error Resume Next
        CellChanges = Evaluate(ThisWorkbook.Names("USED").RefersTo)
        If CellChanges < 1 Then CellChanges = 1      'first used
        CellChanges = Evaluate(ThisWorkbook.Names("USED").RefersTo) + 1
        MsgBox CellChanges    '<- test delete
        ThisWorkbook.Names.Add Name:="USED", RefersTo:="=" & CellChanges
    End If
    On Error GoTo 0
End Sub

**defy** · 12-19-2010, 04:50 PM

Originally Posted by royUK

Perhaps storing as a Name would be best, then it should be less likely to be deleted accidentally


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim CellChanges As Long
    If Target.Address = "$A$1" Then
        On Error Resume Next
        CellChanges = Evaluate(ThisWorkbook.Names("USED").RefersTo)
        If CellChanges < 1 Then CellChanges = 1      'first used
        CellChanges = Evaluate(ThisWorkbook.Names("USED").RefersTo) + 1
        MsgBox CellChanges    '<- test delete
        ThisWorkbook.Names.Add Name:="USED", RefersTo:="=" & CellChanges
    End If
    On Error GoTo 0
End Sub

I take it this code changes the cells name? doesn't change for me for some reason...
I was thinking maybe to create an auto comment?
The thing is if i want to graph the data later on i will have to extract it further. Having it stored in a spare sheet is much easier.

So as mentioned above, if i have a macro that can date how much of the particular material has been withdrawn i would be able to sum then and have my monthly and yearly figures

Something like this maybe?

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

If Target.Address = "$A$2" Then

Dim CountSht As Worksheet
Set CountSht = Worksheets("Counters")
        
    'check if cell actually changed
    If CountSht.Range("E2") = Range("A2") Then
        Exit Sub
    Else
        CountSht.Range("E2") = Range("A2")
        CountSht.Range("F2") = Now()
    End If
    
    'count day events
    If CountSht.Range("C2") = CountSht.Range("B2") Then
        CountSht.Range("D2") = CountSht.Range("D2") + 1
    Else
        CountSht.Range("C2") = CountSht.Range("B2")
        CountSht.Range("D2") = 1
    End If
    
    'count week events
    If CountSht.Range("C3") = CountSht.Range("B3") Then
        CountSht.Range("D3") = CountSht.Range("D3") + 1
    Else
        CountSht.Range("C3") = CountSht.Range("B3")
        CountSht.Range("D3") = 1
    End If
    
    'count month events
    If CountSht.Range("C4") = CountSht.Range("B4") Then
        CountSht.Range("D4") = CountSht.Range("D4") + 1
    Else
        CountSht.Range("C4") = CountSht.Range("B4")
        CountSht.Range("D4") = 1
    End If
    
    'count year events
    If CountSht.Range("C5") = CountSht.Range("B5") Then
        CountSht.Range("D5") = CountSht.Range("D5") + 1
    Else
        CountSht.Range("C5") = CountSht.Range("B5")
        CountSht.Range("D5") = 1
    End If

End If

End Sub