VBA change range of this counter

[Kra]

Hi all!

I can't fix counter in my macro. As you see on mini-sheet:
A list of unique values in column B.
Export in columns J-K
Column J - values from column B, but sometimes duplicated entries
Column K - has "X" or empty.

Now in E2 I have a counter for values from J-K without status "X". It shows 2, because it found 2 lines without "X". But both of lines are for value "B", so I want it to show 1 instead of 2. I need it to check how many values from column B are without status "X" in columns J-K. Any ideas how to fix it?

Dim LastRow1 As Long
        LastRow1 = Cells(Rows.count, "B").End(xlUp).Row
Dim LastRow2 As Long
        LastRow2 = Cells(Rows.count, "J").End(xlUp).Row
Dim counter As Long
Dim x As Long
Dim y As Long
   


'Loop in both ranges
    For x = 3 To LastRow1
        For y = 3 To LastRow2
            If range("B" & x) = range("J" & y) Then
'If material has no X
            If UCase(range("K" & y)) <> "X" Then
'Add to counter
                counter = counter + 1
            End If
            End If
        Next y
    Next x
   
   
'Display results in E2
    If counter  > 0 Then
        range("E2") =counter
        range("E2").Font.ColorIndex = 45
       
    Else
        range("e2") = "All set to X"
        range("e2").Font.ColorIndex = 10
    End If

Book2
	A	B	C	D	E	F	G	H	I	J	K	L	M
1					Without status
2		List of values			2					Values	Status
3		A								A	X
4		B								A	X
5		C								B
6		D								B
7		E								C	X
8		F								C	X
9		G								C	X
10		H								D	X
11		I								E	X
12		J								E	X
13		K								F	X
14		L								G	X
15		M								G	X
16
Sheet1

 

[Kra]

If you need a macro, then try this version:

Sub CountMissingXL()
Dim myTbl As Range, mStr As String, Miss As Long, xCol As Variant
'
Set myTbl = Sheets("List").Range("J3")      '<<< The topleft corner of the table
xCol = "L"                                  '<<< The column with the X
'
mStr = ""
Set myTbl = Range(myTbl, myTbl.End(xlDown).Offset(0, 1))
xCol = Cells(1, xCol).Column - myTbl.Cells(1, 1).Column + 1
For I = 1 To myTbl.Rows.Count
    If myTbl.Cells(I, 1) <> "" Then
        If myTbl.Cells(I, xCol) = "" And InStr(1, mStr, "##" & myTbl.Cells(I, 1), vbTextCompare) = 0 Then
            mStr = mStr & "##" & myTbl.Cells(I, 1)
            Miss = Miss + 1
        End If
    End If
Next I
Range("L1") = Miss             'MISS Contains the result
End Sub

With this version you have the option to set both the start of the table (J3, in the example) and the column that contains the X (K in your first request, L in a second hypotesis)

Or you may convert the code into a Function:

Function MissingX(ByRef myRan As Range, myX As String) As Long
Dim myTbl As Range, mStr As String, Miss As Long, xCol As Variant
'
Set myTbl = Range(myRan, myRan.End(xlDown).Offset(0, 1))
xCol = ThisWorkbook.Sheets(1).Cells(1, myX).Column - myTbl.Cells(1, 1).Column + 1
For I = 1 To myTbl.Rows.Count
    If myTbl.Cells(I, 1) <> "" Then
        If myTbl.Cells(I, xCol) = "" And InStr(1, mStr, "##" & myTbl.Cells(I, 1), vbTextCompare) = 0 Then
            mStr = mStr & "##" & myTbl.Cells(I, 1)
            Miss = Miss + 1
        End If
    End If
Next I
MissingX = Miss
End Function

Then you may "call" this function from your macro using as parametres the start address of the "Values" table and the column with the X. For example

Range("L2").value = MissingX(Sheets("List").Range("J3"), "L")

Beware: it's true that you can insert this function in a formula, for example in L2: =MissingX(J3;"L")
But its result will not recalculate automatically (as you would expect from a formula) when Values or X are modified; given your preference to vba I assume this is not a real worry

Thank you, both solutions work perfectly!