Counting how many times a cell is changed to a certain value using a formula and not cell selection.

[MTOXQUI]

Hello Everyone
First of all i want to thank the community for all the help you guys have given me indirectly. I usually browse around for hours looking for an answer that suits my needs instead of creating a new thread, but this time I am pretty lost.

Basically I am going to use a hand held scanner to input data into one cell (B1) in a spreadsheet. The data is going to be composed of natural numbers(no fractions/negatives).
I wrote a formula [=IF(C3=$B$1,"X"," ")] in the "B" row(B3:B650) that checks weather the adjacent number in the "C" row(C3:C650) matches the value of the (B1) cell. If it does, then it returns an "X". If it doesn't then it returns a blank value.

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD]SCANNER INPUT[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]COUNTER[/TD]
[TD]SCANNED[/TD]
[TD]NUMBER[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD][/TD]
[TD]=IF(C3=$B$1,"X"," ")[/TD]
[TD]10[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD][/TD]
[TD]=IF(C4=$B$1,"X"," ")[/TD]
[TD]11[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD][/TD]
[TD]=IF(C5=$B$1,"X"," ")[/TD]
[TD]12[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD][/TD]
[TD]=IF(C6=$B$1,"X"," ")[/TD]
[TD]13[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD][/TD]
[TD]=IF(C7=$B$1,"X"," ")[/TD]
[TD]14[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


I have been using the following code which i found in another thread:

--------------------------
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

' value to look for ... if a changed cell contains KEY then +1 the corresponding row in offset column
Const KEY = "X"
' user input is col C... we want to change corresponding row in F therefore col offset is 3
Const COL_OFFSET = -1

Dim userInputRng As Range: Set userInputRng = Me.Range("B3:B650")
Dim inputTest As Range: Set inputTest = Intersect(Target, userInputRng)

If inputTest Is Nothing Then Exit Sub

If UCase(Target.Value) = UCase(KEY) Then Target.Offset(0, COL_OFFSET).Value = Target.Offset(0, COL_OFFSET).Value + 1

End Sub
----------------------------

The problem is that the code only executes the counting whenever i select the cell and either type an "X" in it or if it already has "X" and i press enter. I want the code to do the counting if the cell is modified by the formula in the "B" column.
ie. If i scan an 11 into B2, and thus B4 goes through its "=IF" formula and returns an "X" value, i want the counter in A4 to increase.
I hope I have made myself clear.

Thanks in advance!

 

[Redwolfx]

Try

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Mycell As Range
Dim LastRow As Long
LastRow = Range("C100000").End(xlUp).Row
If Not Intersect(Target, Range("B2:B2")) Is Nothing Then
    For Each Mycell In Range("A4:A" & LastRow)
        If Mycell(1, 2).Value = "X" Then
            Mycell.Value = Mycell.Value + 1
        End If
    Next Mycell
End If
End Sub

 

[BrianMH]

So what you want is to increment the value in A if the value that gets scanned into B1 appears in column C?

If so you don't need the formula in column B you could even get rid of that column but you'll need to change the column references in this code.

FYI redwolfx I think you have the columns backwards and the rows offset 1 down.

The use of find also means you don't have to loop through all the cells so should be quicker.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rSearch As Range
    Dim rFound As Range
    If Target.Cells.Count > 1 Or _
        Intersect(Target, Me.Range("B1")) Is Nothing Then Exit Sub
        
    Set rSearch = Me.Range("C2:C" & Me.Rows.Count)
    On Error Resume Next
    Set rFound = rSearch.Find(Me.Range("B1"), rSearch.Cells(rSearch.Rows.Count, 1), _
                              xlValues, xlWhole, xlByRows, xlNext, False, False, False)
    On Error GoTo 0
    If rFound Is Nothing Then Exit Sub
    With Me.Range("A" & rFound.Row)
        .Value = .Value + 1
    End With
End Sub

 

[MTOXQUI]

Thank you so much for your help guys. Brian, I just noticed the numbers I am going to be pasting into the C column end with .00
For example 10.00, 11.00, 12.00 etc.

The code you made doesnt seem to work in that situation, which i realize is my mistake for not telling you about the extra zeros. Is there any way I can get the code to work with the extra zeros.
Other than that, the code works great. You guys are geniuses!

Thanks!

 

[Redwolfx]

At the end of the code put Range("B1").Select That will solve to moving of the cell.

Will they ALWAYS end in .00?

Try This, It seems to work.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Mycell As Range
Dim MyRange As Range
Dim LastRow As Long
LastRow = Range("C100000").End(xlUp).Row
If Not Intersect(Target, Range("B1")) Is Nothing Then
    Set MyRange = Range("C3:C" & LastRow)
    On Error Resume Next
    Set Mycell = MyRange.Find(Range("B1").Value & ".00", MyRange.Cells(MyRange.Rows.Count, 1), xlValues, xlWhole, xlByRows, xlNext, False, False, False)
    On Error GoTo 0
    If Mycell Is Nothing Then Exit Sub
        Mycell(1, -1).Value = Mycell(1, -1).Value + 1
    End If
    
    Range("B1").Select
End Sub

 

[MTOXQUI]

Thanks for your help Red. The code you provided gives me an application-defined or object-defined error. And the numbers will always come with a decimal point and two zeros.
I got rid of the formula in column B as suggested. I also found a work around to my moving cell problem. All i need now is to be able to compare cells that are formatted as numbers for exmaple 10.00, 11.00 etc. If i change their format to general(10.00, 11.00, 12.00 --> 10, 11, 12) then the following code works:
----
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rSearch As Range
Dim rFound As Range
If Target.Cells.Count > 1 Or _
Intersect(Target, Me.Range("B1")) Is Nothing Then Exit Sub

Set rSearch = Me.Range("B3:B" & Me.Rows.Count)
On Error Resume Next
Set rFound = rSearch.Find(Me.Range("B1"), rSearch.Cells(rSearch.Rows.Count, 1), _
xlValues, xlWhole, xlByRows, xlNext, False, False, False)
On Error GoTo 0
If rFound Is Nothing Then Exit Sub
With Me.Range("A" & rFound.Row)
.Value = .Value + 1
End With
End Sub
----

But since the information I am pasting comes with number formatting a decimal point and two zeros, the code doesn't work. If you can help me with this it would be great, otherwise i can just paste the information and match the destination formatting. EITHER WAY THANK YOU SO MUCH RED AND BRIAN

 

[Redwolfx]

Here you go

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Mycell As Range
Dim MyRange As Range
Dim LastRow As Long
LastRow = Range("B100000").End(xlUp).Row
12 If Not Intersect(Target, Range("B1")) Is Nothing Then
    Set MyRange = Range("B3:B" & LastRow)
    On Error Resume Next
    Set Mycell = MyRange.Find(Range("B1").Value & ".00", MyRange.Cells(MyRange.Rows.Count, 1), xlValues, xlWhole, xlByRows, xlNext, False, False, False)
    On Error GoTo 0
    If Mycell Is Nothing Then Exit Sub
        Mycell(1, 0).Value = Mycell(1, 0).Value + 1
    End If
    
    Range("B1").Select
End Sub

 

[MTOXQUI]

Hi Red
That works great. Thank you so much. I think I can start using the spreadsheet today
You guys are awesome!

 

[Redwolfx]

Glad to help. Thanks for the feedback

 

[MTOXQUI]

Hey Red how are you?
I have another question and maybe you can help me. How hard would it be to add letters into the equation?
For Example:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Count[/TD]
[TD]Number[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]2.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]2a.00[/TD]
[/TR]
</tbody>[/TABLE]

The values would still end with .00 but they might be letters involved.
Is that even possible? If it isnt then I want to take the opportunity to thank you guys again for all your help!