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

MTOXQUI · Jun 6, 2014

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

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 · Jun 6, 2014

Try

Code:

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 · Jun 6, 2014

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.

Code:

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 · Jun 6, 2014

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 · Jun 6, 2014

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.

Code:

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 · Jun 6, 2014

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 · Jun 6, 2014

Here you go

Code:

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 · Jun 9, 2014

Hi Red
That works great. Thank you so much. I think I can start using the spreadsheet today

You guys are awesome!

Redwolfx · Jun 9, 2014

Glad to help. Thanks for the feedback

MTOXQUI · Jun 10, 2014

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:

Count	Number
	1.00
	2.00
	2a.00

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!

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

MTOXQUI

New Member

Excel Facts

Redwolfx

Well-known Member

BrianMH

Well-known Member

MTOXQUI

New Member

Redwolfx

Well-known Member

MTOXQUI

New Member

Redwolfx

Well-known Member

MTOXQUI

New Member

Redwolfx

Well-known Member

MTOXQUI

New Member

Similar threads

Forum statistics

Share this page

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

New Member

Excel Facts

Well-known Member

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock