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

 

[Anthony47]

For example, via formula:

=LET(vArr,J3:J20,sArr,K3:K20,COUNTA(UNIQUE(IF((sArr="")*(vArr<>""),vArr,"X")))-1)

 

[Kra]

For example, via formula:

=LET(vArr,J3:J20,sArr,K3:K20,COUNTA(UNIQUE(IF((sArr="")*(vArr<>""),vArr,"X")))-1)

I'm sorry, but I just started my VBA journey. It's important that this part of check will be done by macro, user is free to use any cell except shown on mini-sheet, so they can simply overwrite something. Is it possible to implement this formula in macro without using any cell in sheet to calculate it?

 

[Anthony47]

I thought you needed to populate cell E2...
Via macro:

Sub CountMissingX()
Dim myTbl As Range, mStr As String, Miss As Long
'
Set myTbl = Sheets("List").Range("J3")      '<<< The topleft corner of the table
'
Set myTbl = Range(myTbl, myTbl.End(xlDown).Offset(0, 1))
For I = 1 To myTbl.Rows.Count
    If myTbl.Cells(I, 1) <> "" Then
        If myTbl.Cells(I, 2) = "" 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
'
' Now variable Miss contains the counter
'
End Sub

The variable Miss will count the missing statuses

 

[Kra]

I thought you needed to populate cell E2...
Via macro:

Sub CountMissingX()
Dim myTbl As Range, mStr As String, Miss As Long
'
Set myTbl = Sheets("List").Range("J3")      '<<< The topleft corner of the table
'
Set myTbl = Range(myTbl, myTbl.End(xlDown).Offset(0, 1))
For I = 1 To myTbl.Rows.Count
    If myTbl.Cells(I, 1) <> "" Then
        If myTbl.Cells(I, 2) = "" 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
'
' Now variable Miss contains the counter
'
End Sub

The variable Miss will count the missing statuses

Thank you! Works perfectly now.

Sorry for amateur question, but is it possible to extend this macro? So it also checks if column L has "1" and shows separate counter in cell M1?

 

[Anthony47]

You mean using column J for the "Value" and column L for the "Status"?
If Yes then try replacing the several "Cells(I, 2)" with Cells(I,3)

 

[Kra]

You mean using column J for the "Value" and column L for the "Status"?
If Yes then try replacing the several "Cells(I, 2)" with Cells(I,3)

Sorry, for late reply. I mean if I can extend this macro to use it for check in column K like it does now and check in column L at the same time. So it checks status X in column K (displays results in L2) and checks status X in column L (displays results in M2).

 

[Anthony47]

So you meant exactly what I guessed; so why didn't you try what I proposed?

But let me return to my first message:
-if your goal is set the result in a cell WHY you don't like the formula?

My suggestion is:
Formula for counting Values in J & Status in K:

=LET(vArr,J3:J20,sArr,K3:K20,COUNTA(UNIQUE(IF((sArr="")*(vArr<>""),vArr,"X")))-1)

Formula for counting Values in J & Status in L:

=LET(vArr,J3:J20,sArr,L3:L20,COUNTA(UNIQUE(IF((sArr="")*(vArr<>""),vArr,"X")))-1)

As demonstrated on the following XL2BB minisheet (formulas are in L1-M1):

BR1 Sales_Ledger RECON(9.2 (version 1).xlsm
	H	I	J	K	L	M	N
1					3	5
2			Values	Status L2	Status M2
3			A	X	X
4			A	X	X
5			B
6			B		X
7			C	X	X
8			C	X	X
9			C	X	X
10			D	X	x
11			E	X	x
12			E	X
13			F
14			G	X
15			G	X
16			ggg	X
17			F
18			G
19
20
21
List

Cell Formulas
Range	Formula
L1	L1	=LET(vArr,J3:J20,sArr,K3:K20,COUNTA(UNIQUE(IF((sArr="")*(vArr<>""),vArr,"X")))-1)
M1	M1	=LET(vArr,J3:J20,sArr,L3:L20,COUNTA(UNIQUE(IF((sArr="")*(vArr<>""),vArr,"X")))-1)

 

[Kra]

So you meant exactly what I guessed; so why didn't you try what I proposed?

But let me return to my first message:
-if your goal is set the result in a cell WHY you don't like the formula?

My suggestion is:
Formula for counting Values in J & Status in K:

=LET(vArr,J3:J20,sArr,K3:K20,COUNTA(UNIQUE(IF((sArr="")*(vArr<>""),vArr,"X")))-1)

Formula for counting Values in J & Status in L:

=LET(vArr,J3:J20,sArr,L3:L20,COUNTA(UNIQUE(IF((sArr="")*(vArr<>""),vArr,"X")))-1)

As demonstrated on the following XL2BB minisheet (formulas are in L1-M1):

BR1 Sales_Ledger RECON(9.2 (version 1).xlsm
	H	I	J	K	L	M	N
1					3	5
2			Values	Status L2	Status M2
3			A	X	X
4			A	X	X
5			B
6			B		X
7			C	X	X
8			C	X	X
9			C	X	X
10			D	X	x
11			E	X	x
12			E	X
13			F
14			G	X
15			G	X
16			ggg	X
17			F
18			G
19
20
21
List

Cell Formulas
Range	Formula
L1	L1	=LET(vArr,J3:J20,sArr,K3:K20,COUNTA(UNIQUE(IF((sArr="")*(vArr<>""),vArr,"X")))-1)
M1	M1	=LET(vArr,J3:J20,sArr,L3:L20,COUNTA(UNIQUE(IF((sArr="")*(vArr<>""),vArr,"X")))-1)

It works great, thank you.

I don't want to use formulas because it will be implemented in workbook with lots of data. It is very formula heavy and most of the time I need to wait 2-3 minutes to calculate everything. We try to avoid more formulas in this dataset, so I created macro from my first post and it was working for us, that's why I wanted to keep using it, I just wasn't able to change counter to count values from column B instead of lines in column J. Some of users also inserts some text and values in cells where counter shows data, but they are not relevant to us so we simply overwrite it with macro.

But thank you for your solution, I will just drop this project.

 

[Anthony47]

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