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

M

MTOXQUI

New Member
Joined
Jun 6, 2014
Messages
15
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.

ABCDE
1SCANNER INPUT
2COUNTERSCANNEDNUMBER
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!
 
Sort by date Sort by votes

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Hey guys... I know you've already helped me a lot and I know this is sort of stepping up the insanity but I want to know if the following concept is even conceivable.

Within the same counting spreadsheet that you pretty much made for me, would it be possible to have a cell that switches to a certain sheet based on weather the scanned values match the name of said sheet?
The reason is: I am thinking about printing labels that have two barcodes; one containing the name of a sheet in a workbook and another containing a number to compare/count against a list(you already helped me with the aforementioned macro).

For example, imagine i want cell A1 to be the "sheet input cell" and I have 4 sheets in a workbook(Sheet1, Sheet2, Sheet3, Sheet4); If i am in Sheet1, A1 and then i scan a barcode that reads "Sheet2", is it possible to have a macro that moves you to Sheet2(Because that is the sheet value scanned), B1(As default, since the following barcode will perform the counting macro)?

Here is a visual example:

ABC
1[SCAN TARGET SHEET][SCAN NUMBER TO COMPARE]
2Scanned QtyNo.
31.00
42.00
Sheet1

<tbody>
</tbody>
This is a representation of Sheet1. As you know, there is a macro that compares a value scanned into "B1" with the rest of column "B". If the value in "B1" matches any other value in the "B" column, a counting begins within the respective adjacent cell in column "A". For example, if a value of 1.00 was scanned in "B1", "A3"would increase its value from nothing to 1.
Now... what I would like to know is if it is possible to have another macro in cell "A1" that will switch cells based on the value scanned into itself. For example if i scan a value of Sheet2 Into cell "A1", the cell celection would switch to "Sheet2" "B1". Then i would scan a number into "B1" and then auto return to cell "A1" in order to specify a sheet once again.

I know this may be extremely confusing.... I can hardly keep up with myself and I am not even doing the programming.. If you guys can get this going then I will be really thankful. Otherwise i want to take a chance to thank you yet again for all your help. The things you can do with excel are truly amazing!
------------------------
Edit: Here is the code that I currently have:

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
 
Last edited:
Upvote 0
So what you want to do is if you are in A1 and scan into that and a sheet by that name exists in the workbook you want to switch to that sheet and activate B1?


Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Mycell As Range
    Dim MyRange As Range
    Dim LastRow As Long
    Dim ws As Worksheet
    If Target.Cells.Count > 1 Then Exit Sub
    LastRow = Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row
    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
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        On Error Resume Next
        Set ws = Sheets(Target.Value)
        On Error GoTo 0
        If ws Is Nothing Then
            Call MsgBox("There is no sheet named " & Target.Value & " in the workbook.  Please ensure you are scanning into the correct cell.", vbCritical, "No Sheet Found")
            Exit Sub
        Else
            ws.Activate
        End If
        Range("B1").Select
    End If
End Sub

FYI please use code tags when posting code to the forum.
 
Upvote 0
BrianMH said:
So what you want to do is if you are in A1 and scan into that and a sheet by that name exists in the workbook you want to switch to that sheet and activate B1?


Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Mycell As Range
    Dim MyRange As Range
    Dim LastRow As Long
    Dim ws As Worksheet
    If Target.Cells.Count > 1 Then Exit Sub
    LastRow = Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row
    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
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        On Error Resume Next
        Set ws = Sheets(Target.Value)
        On Error GoTo 0
        If ws Is Nothing Then
            Call MsgBox("There is no sheet named " & Target.Value & " in the workbook.  Please ensure you are scanning into the correct cell.", vbCritical, "No Sheet Found")
            Exit Sub
        Else
            ws.Activate
        End If
        Range("B1").Select
    End If
End Sub

FYI please use code tags when posting code to the forum.
Click to expand...

Yes that is exactly what i want :biggrin:! Ill make sure to use code tags from now on.
When I use the code, It does switch me to the respective Sheet but not the cell. It also gives me an error:

Run-time error '1004';
Selected Method of Range class failed

It does work if the value scanned into A1 matches the name of the current sheet.
Thank you so much!@
 
Upvote 0
Try:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Mycell As Range
    Dim MyRange As Range
    Dim LastRow As Long
    Dim ws As Worksheet
    Dim WSN As String
    
    If Target.Cells.Count > 1 Then Exit Sub
    LastRow = Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row
    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
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        On Error Resume Next
        WSN = Target.Value
        Set ws = Sheets(WSN)
        On Error GoTo 0
        If ws Is Nothing Then
            Call MsgBox("There is no sheet named " & Target.Value & " in the workbook.  Please ensure you are scanning into the correct cell.", vbCritical, "No Sheet Found")
            Exit Sub
        Else
            ws.Activate
        End If
        ws.Range("B1").Select
    End If
End Sub
 
Upvote 0
Redwolfx said:
Try:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Mycell As Range
    Dim MyRange As Range
    Dim LastRow As Long
    Dim ws As Worksheet
    Dim WSN As String
    
    If Target.Cells.Count > 1 Then Exit Sub
    LastRow = Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row
    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
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        On Error Resume Next
        WSN = Target.Value
        Set ws = Sheets(WSN)
        On Error GoTo 0
        If ws Is Nothing Then
            Call MsgBox("There is no sheet named " & Target.Value & " in the workbook.  Please ensure you are scanning into the correct cell.", vbCritical, "No Sheet Found")
            Exit Sub
        Else
            ws.Activate
        End If
        ws.Range("B1").Select
    End If
End Sub
Click to expand...
Yup that works! Is there a way to make it so when I scan a a value in B1 it then returns to A1? Right now the macro does send me to the respective sheet+B1, but after I enter a value in B1, it stays there instead of going back to A1. I want to enter a sheet name followed by a B1 value followed by another sheet name and then another B1 value sort of in a loop.
So it will be like

1. Slected Sheet and Cell= Sheet1, A1
2. Scanner enteres "Sheet2" into Sheet1, A1
3. Selection goes to Sheet2, B1
4. Scanner enters a value into B1 to compare against a list and count the matching value.
5. Selection goes back to A1 and waits for another Sheet name input by the scanner.
 
Upvote 0
I Think this will handle it

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Mycell As Range
    Dim MyRange As Range
    Dim LastRow As Long
    Dim ws As Worksheet
    Dim WSN As String
    
    If Target.Cells.Count > 1 Then Exit Sub
    LastRow = Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row
    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
        Range("A1").Select
    End If
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        On Error Resume Next
        WSN = Target.Value
        Set ws = Sheets(WSN)
        On Error GoTo 0
        If ws Is Nothing Then
            Call MsgBox("There is no sheet named " & Target.Value & " in the workbook.  Please ensure you are scanning into the correct cell.", vbCritical, "No Sheet Found")
            Exit Sub
        Else
            ws.Activate
        End If
        ws.Range("B1").Select
    End If
End Sub
 
Upvote 0
Redwolfx said:
I Think this will handle it

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Mycell As Range
    Dim MyRange As Range
    Dim LastRow As Long
    Dim ws As Worksheet
    Dim WSN As String
    
    If Target.Cells.Count > 1 Then Exit Sub
    LastRow = Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row
    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
        Range("A1").Select
    End If
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        On Error Resume Next
        WSN = Target.Value
        Set ws = Sheets(WSN)
        On Error GoTo 0
        If ws Is Nothing Then
            Call MsgBox("There is no sheet named " & Target.Value & " in the workbook.  Please ensure you are scanning into the correct cell.", vbCritical, "No Sheet Found")
            Exit Sub
        Else
            ws.Activate
        End If
        ws.Range("B1").Select
    End If
End Sub
Click to expand...
That's it. I have already thanked too many times it seems kind pointless now. All i have left to say is WOW (y)
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Compare cell in column to cells below
2
Replies
13
Views
659
kevin9999
K
C
  • Question
Colouring cells based on contains value
Replies
2
Views
162
CawstonT
C
F
  • Question
count the number of cells (in a range) greater than a cell value
Replies
9
Views
184
Flavien
F
J
  • Solved
HYPERLINK - How to add a hyperlink to a cell and use the original cell value as the hyperlink text? Arrrgggghhh!!!
Replies
2
Views
425
jswhip
J
C
  • Question
Finding any two values in each cell text in a column of cells with both values as one Textbox1 variable
2
Replies
10
Views
314
chazrab
C

Forum statistics

Threads
1,216,028
Messages
6,128,393
Members
449,446
Latest member
CodeCybear

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top