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.

	A	B	C	D	E
1		SCANNER INPUT
2	COUNTER	SCANNED	NUMBER
3		=IF(C3=$B$1,"X"," ")	10
4		=IF(C4=$B$1,"X"," ")	11
5		=IF(C5=$B$1,"X"," ")	12
6		=IF(C6=$B$1,"X"," ")	13
7		=IF(C7=$B$1,"X"," ")	14

<tbody>
</tbody>

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!

 

[BrianMH]

It should still work as long as the value in B1 has the letter also.

 

[MTOXQUI]

I could be doing something wrong but I can't seem to make it work. It works fine with number values but when i add a letter then it stops counting.

 

[Redwolfx]

when you scan it does it come up 2a.00?

 

[BrianMH]

OK.

I have a few questions. Can you give me an example of what exactly is being input into B1? Please give an example with a letter and example without a letter.

In the column with the values you need to find are these all numbers stored as text or are they actually stored as numbers? The way to tell is if you change the format to general the .00 will disappear. What is the format of B1?

 

[MTOXQUI]

when you scan it does it come up 2a.00?

Yup.
Some of them come up as 10.00, 11.00, 12.00 etc.
Others come up as 10a.00, 11a.00, 11b.00 etc. Basically any combo of number and lower case letter followed by .00

 

[MTOXQUI]

OK.

I have a few questions. Can you give me an example of what exactly is being input into B1? Please give an example with a letter and example without a letter.

In the column with the values you need to find are these all numbers stored as text or are they actually stored as numbers? The way to tell is if you change the format to general the .00 will disappear. What is the format of B1?

Values being input in B1 are either numbers followed by .00 such as 10.00, 11.00, 12.00, 100.00, or numbers followed by an upper case letter and .00 for example 11a.00, 11b.00, 12a.00 etc

The B column that contains the values I need to find and the input value (B1) is formatted as Number. If i switch it to general, then the 0s in the values I need to find go away, but the scanner still inputs a value followed by .00

 

[Redwolfx]

See if this works out for you.

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").Text, MyRange.Cells(MyRange.Rows.Count, 1), xlValues, xlWhole, xlByRows, xlNext, False, False, False)
    If Err <> "" Then
        Set Mycell = MyRange.Find(Range("B1").Value & ".00", MyRange.Cells(MyRange.Rows.Count, 1), xlValues, xlWhole, xlByRows, xlNext, False, False, False)
        Err = ""
    End If
    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

 

[Redwolfx]

Sorry, Another slight change. This should work.

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").Text, MyRange.Cells(MyRange.Rows.Count, 1), xlValues, xlWhole, xlByRows, xlNext, False, False, False)
    If Mycell = "" Then
        Set Mycell = MyRange.Find(Range("B1").Value & ".00", MyRange.Cells(MyRange.Rows.Count, 1), xlValues, xlWhole, xlByRows, xlNext, False, False, False)
    End If
    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]

sec

 

[MTOXQUI]

Sorry, Another slight change. This should work.

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").Text, MyRange.Cells(MyRange.Rows.Count, 1), xlValues, xlWhole, xlByRows, xlNext, False, False, False)
    If Mycell = "" Then
        Set Mycell = MyRange.Find(Range("B1").Value & ".00", MyRange.Cells(MyRange.Rows.Count, 1), xlValues, xlWhole, xlByRows, xlNext, False, False, False)
    End If
    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

That is unbelievable, is there anything you guys can't do?
It works perfectly and it fits my needs like a glove. Thank you so much Red and Brian