Counting how many times data is entered
Posted by Gerard on August 31, 2001 10:34 PM
I would like to count the number of times data is entered into a particular cell. I can't figure out how to do it without incurring a circular reference error message.
Thanks
Posted by Tom Morales on September 01, 2001 12:44 PM
Gerard -
The following code should do it. Right-click the worksheet tab, choose "View Code", and insert the following code (with cell references adjusted per your whims):
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Cell A2 will be the register that counts the changes
n = [A2].Value
'Cell "A1" is the one we're monitoring, here
If Target.Address = "$A$1" Then
n = n + 1
[A2].Value = n
End If
End Sub
Have fun...
Tom
Posted by Tom Morales on September 01, 2001 12:44 PM
Gerard -
The following code should do it. Right-click the worksheet tab, choose "View Code", and insert the following code (with cell references adjusted per your whims):
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Cell A2 will be the register that counts the changes
n = [A2].Value
'Cell "A1" is the one we're monitoring, here
If Target.Address = "$A$1" Then
n = n + 1
[A2].Value = n
End If
End Sub
Have fun...
Tom
Posted by Ivan F Moala on September 01, 2001 11:50 PM
Another way
Another way is to put the number of times
data has been entered into a comment.
Select sheet tab and right click, select view code
and add this;
Public Count
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$D$6" Then
On Error Resume Next
'Place count in comments
Target.AddComment
Target.Comment.Text "Data has been entered " & Count & " times."
'OR place count intto adjacent cell
Target.Offset(0, 1) = Count
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If ActiveCell.Address <> Target.Address Then Exit Sub
If Target.Address = "$D$6" Then
If Target.Value = "" Then
Count = 1
Else
Count = GetCount(Target.Address) + 1
End If
End If
End Sub
In a module add this function
Function GetCount(AddrofComment As String)
Dim Txt As Comment
Dim N, x, Tmp
On Error GoTo E
Set Txt = Range(AddrofComment).Comment
On Error Resume Next
x = 0
Do Until N = " "
N = Mid(Txt.Text, 23 + x, 1)
Tmp = Tmp & N
x = x + 1
Loop
GetCount = Tmp
Exit Function
E:
GetCount = 1
End Function
Posted by Tom Morales on September 02, 2001 7:39 AM
Re: Another way
Ivan -
The line
Count = GetCount(Target.Address) + 1
Gave me a run time error "13" for type mismatch.
What's awry, here? Any thoughts?
Tom
Posted by Tom Morales on September 02, 2001 10:07 AM
Yet another way
Ivan,
Thinking about your approach - using the comment field - this could be another way, with fewer VBA pyrotechnics...
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$B$7" Then
On Error Resume Next
x = Target.Comment.Text
If x = Empty Then
Target.AddComment
Target.Comment.Text "1 input, so far"
GoTo line99
End If
End If
n = Val(x)
n = n + 1
Target.Comment.Text n & " inputs, so far"
line99:
End Sub
Tom
