Timestamp/Counter

Anyway, as you can see there are two sets of counters in the sheet that I have attached.  First, I need an additional two sets of counters (i.e. there is currently one counter set in columns A-E and a second counter set n columns F-J.  I need a new counter set in columns K-O and another set in columns P-T.)

Next, the current formula only works if I manually enter a new value in the columns entitled "Number 1".  All of the columns that will be "Number 1" columns (A,F,K, and P) will be DDE Linked to my stock trading platform and will update automatically.  I need this formula to be altered so that the counters function in the exact same manner, but change automatically when the DDE linked cells change.  This is also described in the post "Excel Event Counter"
http://www.experts-exchange.com/Q_25589817.html

Finally, I will need the columns labeled "# (1>2) and # (1<2) to create a timestamp when the values in these cells change.  This request is similar to the request in my old post "Timestamp in Excel."  Once again, these cells will be changing automatically and I need the timestamps to be able to update automatically when a change occurs.  The targets and timestamps are as follows:

Cells in column C will timestamp column U
Cells in column I will timestamp column V
Cells in column M will timestamp column W
Cells in column S will timestamp column X

Note: When I ultimately construct this spreadsheet, the cells in the columns Labeled "Number 1" and "Number 2" will be populated when the spreadsheet opens.

Thank you, I know this is a tough one but I greatly appreciate the help.  Please let me know if you have any questions.
-ZacharyDG


Counter-Code.txt
counter.xlsx
ZacharyDGAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

nicsaintCommented:
Attached is updated code to cover the existence of the additional two sets of counters and to work when eiither column "Number1 or "Number2" is changed" in each set.
I was a little unsure about the columns you were looking to place the timestampin, so changes to #1>2 or #1<2 in each of the four sets place a time stamp in Colums U,V,W & X respectively.

Regarding auto update of the cells I would look along the lines of possibly duplicating the worksheet before auto population and then running the code compariing the old data against the new.

Hope this helps
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngValue2 As Range, rngGreaterThan As Range, rngLessThan As Range, rngLastAction As Range
    
    If ((Target.Column = 1) Or (Target.Column = 6) Or (Target.Column = 11) Or (Target.Column = 16)) Then
        Set rngValue2 = Sheet1.Cells(Target.Row, Target.Column + 1)
        Set rngGreaterThan = Sheet1.Cells(Target.Row, Target.Column + 2)
        Set rngLessThan = Sheet1.Cells(Target.Row, Target.Column + 3)
        Set rngLastAction = Sheet1.Cells(Target.Row, Target.Column + 4)
        Set rngTimeStamp = Sheet1.Cells(Target.Row, 21 + Int(Target.Column / 5))
    
        If Target.Value > rngValue2.Value Then
            If rngLastAction <> ">" Then
                rngGreaterThan = rngGreaterThan + 1
                rngTimeStamp.Value = Now()
                rngLastAction = ">"
            End If
        ElseIf Target.Value < rngValue2.Value Then
            If rngLastAction <> "<" Then
                rngLessThan = rngLessThan + 1
                rngTimeStamp.Value = Now()
                rngLastAction = "<"
            End If
        'Else Values are Equal; Do Nothing
        ' If you want equal values to do something, change the one of the above
        ' formulas from > to >= or < to <=
        End If
        
        Set rngValue2 = Nothing
        Set rngGreaterThan = Nothing
        Set rngLessThan = Nothing
        Set rngLastAction = Nothing
        Set rngTimeStamp = Nothing
    End If
    
    If ((Target.Column = 2) Or (Target.Column = 7) Or (Target.Column = 12) Or (Target.Column = 17)) Then
        Set rngValue2 = Sheet1.Cells(Target.Row, Target.Column - 1)
        Set rngGreaterThan = Sheet1.Cells(Target.Row, Target.Column + 2)
        Set rngLessThan = Sheet1.Cells(Target.Row, Target.Column + 1)
        Set rngLastAction = Sheet1.Cells(Target.Row, Target.Column + 3)
        Set rngTimeStamp = Sheet1.Cells(Target.Row, 21 + Int(Target.Column / 5))
    
        If Target.Value > rngValue2.Value Then
            If rngLastAction <> "<" Then
                rngGreaterThan = rngGreaterThan + 1
                rngTimeStamp.Value = Now()
                rngLastAction = "<"
            End If
        ElseIf Target.Value < rngValue2.Value Then
            If rngLastAction <> ">" Then
                rngLessThan = rngLessThan + 1
                rngTimeStamp.Value = Now()
                rngLastAction = ">"
            End If
        'Else Values are Equal; Do Nothing
        ' If you want equal values to do something, change the one of the above
        ' formulas from > to >= or < to <=
        End If
        
        Set rngValue2 = Nothing
        Set rngGreaterThan = Nothing
        Set rngLessThan = Nothing
        Set rngLastAction = Nothing
        Set rngTimeStamp = Nothing
    End If
End Sub

Open in new window

0
nicsaintCommented:
I gave some thought overnight to the problem of automatic updates and came up with a possible solution by running loop to run through each cell and call the existing code to action any relevant changes.

Since the existing script does nothing unless "Number1" is now bigger or smaller than "Number2", code to run through each cell in each of the 4 sets and can prpvode the target cell reference to the existing code, which in turn will update the counters and timestamp when there has been a change.
0
nicsaintCommented:
Attached is the update workbook including random data in Sheet2 representing the changing source data.
The data in sheet1 is linked to the data in sheet2 and checked every 10 seconds for changes.
Place the first piece of code below into the "ThisWorkbook" Module
Private Sub Workbook_Open()
   Application.OnTime EarliestTime:=Now + TimeValue("00:00:10"), Procedure:="Sheet1.CheckMyData"
End Sub
Place the following code in the "Sheet1" Module
Sub CheckMyData()
    Dim CellEntry
    For Each CellEntry In Sheet1.Range("A2", Range("B3").End(xlDown))
        WorksheetChange (CellEntry)
    Next
    For Each CellEntry In Sheet1.Range("F2", Range("G3").End(xlDown))
        WorksheetChange (CellEntry)
    Next
    For Each CellEntry In Sheet1.Range("K2", Range("L3").End(xlDown))
        WorksheetChange (CellEntry)
    Next
    For Each CellEntry In Sheet1.Range("P2", Range("Q3").End(xlDown))
        WorksheetChange (CellEntry)
    Next
Application.OnTime EarliestTime:=Now + TimeValue("00:00:10"), Procedure:="Sheet1.CheckMyData"
End Sub
Sub WorksheetChange(ByVal Target As Range)
    Dim rngValue2 As Range, rngGreaterThan As Range, rngLessThan As Range, rngLastAction As Range
    If ((Target.Column = 1) Or (Target.Column = 6) Or (Target.Column = 11) Or (Target.Column = 16)) Then
        Set rngValue2 = Sheet1.Cells(Target.Row, Target.Column + 1)
        Set rngGreaterThan = Sheet1.Cells(Target.Row, Target.Column + 2)
        Set rngLessThan = Sheet1.Cells(Target.Row, Target.Column + 3)
        Set rngLastAction = Sheet1.Cells(Target.Row, Target.Column + 4)
        Set rngTimeStamp = Sheet1.Cells(Target.Row, 21 + Int(Target.Column / 5))
   
        If Target.Value > rngValue2.Value Then
            If rngLastAction <> ">" Then
                rngGreaterThan = rngGreaterThan + 1
                rngTimeStamp.Value = Now()
                rngLastAction = ">"
            End If
        ElseIf Target.Value < rngValue2.Value Then
            If rngLastAction <> "<" Then
                rngLessThan = rngLessThan + 1
                rngTimeStamp.Value = Now()
                rngLastAction = "<"
            End If
        ' Else Values are Equal- Do Nothing
        ' If you want equal values to do something, change the one of the above
        ' formulas from > to >= or < to <=
        End If
       
        Set rngValue2 = Nothing
        Set rngGreaterThan = Nothing
        Set rngLessThan = Nothing
        Set rngLastAction = Nothing
        Set rngTimeStamp = Nothing
    End If
   
    If ((Target.Column = 2) Or (Target.Column = 7) Or (Target.Column = 12) Or (Target.Column = 17)) Then
        Set rngValue2 = Sheet1.Cells(Target.Row, Target.Column - 1)
        Set rngGreaterThan = Sheet1.Cells(Target.Row, Target.Column + 2)
        Set rngLessThan = Sheet1.Cells(Target.Row, Target.Column + 1)
        Set rngLastAction = Sheet1.Cells(Target.Row, Target.Column + 3)
        Set rngTimeStamp = Sheet1.Cells(Target.Row, 21 + Int(Target.Column / 5))
   
        If Target.Value > rngValue2.Value Then
            If rngLastAction <> "<" Then
                rngGreaterThan = rngGreaterThan + 1
                rngTimeStamp.Value = Now()
                rngLastAction = "<"
            End If
        ElseIf Target.Value < rngValue2.Value Then
            If rngLastAction <> ">" Then
                rngLessThan = rngLessThan + 1
                rngTimeStamp.Value = Now()
                rngLastAction = ">"
            End If
        'Else Values are Equal; Do Nothing
        ' If you want equal values to do something, change the one of the above
        ' formulas from > to >= or < to <=
        End If
       
        Set rngValue2 = Nothing
        Set rngGreaterThan = Nothing
        Set rngLessThan = Nothing
        Set rngLastAction = Nothing
        Set rngTimeStamp = Nothing
    End If
End Sub
 
counter.xls
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

ZacharyDGAuthor Commented:
I am getting an error message that says cannot run the macro...The macro may not be available in the workbook or all macros may be disabled.  Do you know why I am getting this message and can you possibly put the macro into a workbook and upload it.
0
ZacharyDGAuthor Commented:
Nevermind, I was able to get this to work and everything works exactly as I had hoped.  Just one small modification; can you change the code so that only columns C, I, M, and S update the timestamp i.e. two sets of the counters will update the timestamp only when #1 is greater than #2 and the other two counters will update the timestamp only when #1 is less than #2.  Hope this is not too much trouble and let me know if you have any further questions.
0
nicsaintCommented:
No problem at all. Now I understand the reason for the differing column ranges updating the timestamp.
Replace the code for Sub WorksheetChange(ByVal Target As Range) with the attached and try it again
 

Dim rngValue2 As Range, rngGreaterThan As Range, rngLessThan As Range, rngLastAction As Range
   If ((Target.Column = 1) Or (Target.Column = 6) Or (Target.Column = 11) Or (Target.Column = 16)) Then
       Set rngValue2 = Sheet1.Cells(Target.Row, Target.Column + 1)
       Set rngGreaterThan = Sheet1.Cells(Target.Row, Target.Column + 2)
       Set rngLessThan = Sheet1.Cells(Target.Row, Target.Column + 3)
       Set rngLastAction = Sheet1.Cells(Target.Row, Target.Column + 4)
       Set rngTimeStamp = Sheet1.Cells(Target.Row, 21 + Int(Target.Column / 5))
   
       If Target.Value > rngValue2.Value Then
           If rngLastAction <> ">" Then
               rngGreaterThan = rngGreaterThan + 1
               If rngGreaterThan.Column = 3 Or rngGreaterThan.Column = 9 Or rngGreaterThan.Column = 13 Or rngGreaterThan.Column = 19 Then rngTimeStamp.Value = Now()
               rngLastAction = ">"
           End If
       ElseIf Target.Value < rngValue2.Value Then
           If rngLastAction <> "<" Then
               rngLessThan = rngLessThan + 1
               If rngLessThan.Column = 3 Or rngLessThan.Column = 9 Or rngLessThan.Column = 13 Or rngLessThan.Column = 19 Then rngTimeStamp.Value = Now()
               rngLastAction = "<"
           End If
       ' Else Values are Equal- Do Nothing
       ' If you want equal values to do something, change the one of the above
       ' formulas from > to >= or < to <=
       End If
       
       Set rngValue2 = Nothing
       Set rngGreaterThan = Nothing
       Set rngLessThan = Nothing
       Set rngLastAction = Nothing
       Set rngTimeStamp = Nothing
   End If
   
   If ((Target.Column = 2) Or (Target.Column = 7) Or (Target.Column = 12) Or (Target.Column = 17)) Then
       Set rngValue2 = Sheet1.Cells(Target.Row, Target.Column - 1)
       Set rngGreaterThan = Sheet1.Cells(Target.Row, Target.Column + 1)
       Set rngLessThan = Sheet1.Cells(Target.Row, Target.Column + 2)
       Set rngLastAction = Sheet1.Cells(Target.Row, Target.Column + 3)
       Set rngTimeStamp = Sheet1.Cells(Target.Row, 21 + Int(Target.Column / 5))
   
       If Target.Value > rngValue2.Value Then
           If rngLastAction <> "<" Then
               rngGreaterThan = rngGreaterThan + 1
               If rngGreaterThan.Column = 3 Or rngGreaterThan.Column = 9 Or rngGreaterThan.Column = 13 Or rngGreaterThan.Column = 19 Then rngTimeStamp.Value = Now()
               rngLastAction = "<"
           End If
       ElseIf Target.Value < rngValue2.Value Then
           If rngLastAction <> ">" Then
               rngLessThan = rngLessThan + 1
               If rngLessThan.Column = 3 Or rngLessThan.Column = 9 Or rngLessThan.Column = 13 Or rngLessThan.Column = 19 Then rngTimeStamp.Value = Now()
               rngLastAction = ">"
           End If
       'Else Values are Equal; Do Nothing
       ' If you want equal values to do something, change the one of the above
       ' formulas from > to >= or < to <=
       End If
       
       Set rngValue2 = Nothing
       Set rngGreaterThan = Nothing
       Set rngLessThan = Nothing
       Set rngLastAction = Nothing
       Set rngTimeStamp = Nothing
   End If

Open in new window

0
ZacharyDGAuthor Commented:
Im not exactly sure what you mean by replace "Sub WorksheetChange(ByVal Target As Range) " with the code below?  Should I take out everything below that line in your original code and replace it with the new piece of code?  I tried doing that and got an error message saying "compile error: Sub or Function not defined" and it highlighted the first line of the code (sub CheckMyData().  How do I properly insert the code to fix this?  If you could upload a spreadsheet that would be great.
0
nicsaintCommented:
Attached is the file with the updated code

counter.xls
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Applications

From novice to tech pro — start learning today.