Question : Counter and Timestamp in Excel

I am looking for someone to expand the VBA programming in the attached spreadsheet to include two more data sets. The current spreadsheet works as follows:

This spreadsheet compares the number in column A (number 1) to the number in column B (Comp 1) which is a static value and counts the number of times number 1 is greater than or less than Comp 1. Then, when number 1 is greater than comp 1, the spreadsheet automatically timestamps column U. A more detailed description can be found in my last post entitled "Timestamp/Counter"

I want to apply this same functionality to the highlighted columns (Y through AJ). Furthermore, I only want column AI to timestamp when Number 5 is greater than comp 5 and I want to timestamp column AJ when Number 6 is less than Comp 6. Please look at the current VBA code and my previous post to see how the current program works. Please let me know if there are any questions. I understand that this is a difficult question and I would be sure to assign an "A" to anyone who is up for the challenge.

Thanks,
Zach

Attachments:

Counter.xlsm (58 KB) (File Type Details)

Main File

Answer : Counter and Timestamp in Excel

I missed the bit with updating the time stamp with case 5 only when greater than and with case 6 only if less than. Since you are always comparing one column with another, it didn't seem necessary to me to loop through all cells in both columns. Eliminating that feature allows WorksheetChange to become much simpler.

Revised code shown below. This code also fixed some bugs in CheckMyData.

Brad

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:



Sub CheckMyData()
Dim CellEntry As Range, rg As Range
Dim addr As Variant
With Sheet1
    For Each addr In Array("A2", "F2", "K2", "P2", "Y2", "AD2")
        Set rg = .Range(CStr(addr))
        Set rg = Range(rg, .Cells(.Rows.Count, rg.Column).End(xlUp))
        For Each CellEntry In rg.Cells
            WorksheetChange CellEntry
        Next
    Next
End With
Application.OnTime EarliestTime:=Now + TimeValue("00:00:10"), Procedure:="CheckMyData"
End Sub

Sub WorksheetChange(ByVal Target As Range)
Dim rngValue2 As Range, rngGreaterThan As Range, rngLessThan As Range, rngLastAction As Range, rngTimeStamp As Range
Select Case Target.Column
Case Is <= 17
    Set rngTimeStamp = Sheet1.Cells(Target.Row, 21 + Int(Target.Column / 5))
Case 25, 26
    Set rngTimeStamp = Sheet1.Cells(Target.Row, 35)
Case 30, 31
    Set rngTimeStamp = Sheet1.Cells(Target.Row, 36)
End Select
Select Case Target.Column
Case 1, 6, 11, 16, 25, 30
    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)
    
    If Target.Value > rngValue2.Value Then
        If rngLastAction <> ">" Then
            rngGreaterThan = rngGreaterThan + 1
            If Target.Column <> 30 Then rngTimeStamp.Value = Now()
            rngLastAction = ">"
        End If
    ElseIf Target.Value < rngValue2.Value Then
        If rngLastAction <> "<" Then
            rngLessThan = rngLessThan + 1
            If Target.Column <> 25 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

End Select

Set rngValue2 = Nothing
Set rngGreaterThan = Nothing
Set rngLessThan = Nothing
Set rngLastAction = Nothing
Set rngTimeStamp = Nothing
End Sub