Dictionary For loop with Multiple If and range

[kirankoushik]

Hello All,

I am trying to create a count for each item in the dictionary, where the values in 2 other columns are > 0

I am only getting the dictionary count as output each time. Please help me understand where I am going wrong.

    dic.CompareMode = vbTextCompare
    Set rRngVisible = Sheets("ScrewPoints").Range("A2").CurrentRegion
        
    For Each rRow In rRngVisible.Rows
            dic(rRow.Cells(2, 6).Value) = ""
    Next rRow
    
    Sheets("Total").Range("C40").Value = dic.Count
    
    k = 0
    
    For Each itm In dic
        'rRngVisible.AutoFilter Field:=6, Criteria1:="5282 01"
        'If Range(AG3 & AG) > 0 & Range(AH3 & AH) > 0 Then k = k + 1
        'k = Application.CountIfs(Range("AG3:AG" & sLastRow), ">0", Range("AH3:AH" & sLastRow), ">0")
        
       If (Sheets("ScrewPoints").Range("AG3:AH" & sLastRow).Value = 0) And _
          (Sheets("ScrewPoints").Range("AH3:AG" & sLastRow).Value = 0) Then
        k = k + 1
        End If
    Next itm
    
    Sheets("Total").Range("C41").Value = k
    k = 0

Thanks

kiran

 

[aRandomHelper]

Since the code uses Sheets("Screwpoints").Range("A2").CurrentRegion, make sure that your sample data is contiguous. If there are "blank" columns in-between data, you need at least a header row to conjoin everything. Otherwise, the code fails with CurrentRegion, as shown with the debug printed address.

 

[kirankoushik]

Since the code uses Sheets("Screwpoints").Range("A2").CurrentRegion, make sure that your sample data is contiguous. If there are "blank" columns in-between data, you need at least a header row to conjoin everything. Otherwise, the code fails with CurrentRegion, as shown with the debug printed address.

whoa.. it works now!

However, one last issue with the count..

it shows 3 and 34... it should be 2 and 35 from the sample data..

 

[aRandomHelper]

I am guessing we are looking at different samples.
Mine shows:
$A$1:$M$65
$A$2:$M$4,$A$8:$M$8,$A$10:$M$10,$A$12:$M$12,$A$17:$M$19,$A$22:$M$22,$A$24:$M$24,$A$26:$M$30,$A$35:$M$37,$A$39:$M$42,$A$46:$M$58,$A$65:$M$65

Can you show your current sample, with an added column that indicates which row should be OK/NOK?

 

[kirankoushik]

I am guessing we are looking at different samples.
Mine shows:
$A$1:$M$65
$A$2:$M$4,$A$8:$M$8,$A$10:$M$10,$A$12:$M$12,$A$17:$M$19,$A$22:$M$22,$A$24:$M$24,$A$26:$M$30,$A$35:$M$37,$A$39:$M$42,$A$46:$M$58,$A$65:$M$65

Can you show your current sample, with an added column that indicates which row should be OK/NOK?

Book1.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1
2	a	b	c	d	e	screwcase	g	h	Finish	Total per set	Total per case	PDM	KS & DV	Result
3						5282 01			Final	0.00	0			NOK
4						7238 01			Final	1.00	1			OK
5						7206 01			Final	0.00	0			NOK
6						5638 01			STG1	1.00	1			NOK
7						5638 01			STG1	1.00	1			NOK
8						7919 01			STG2	2.00	2			NOK
9						7919 01			Final	2.00	2			NOK
10						7919 01			STG2	2.00	2			NOK
11						7919 01			Final	2.00	2			NOK
12						7225 01			STG1	1.00	1			NOK
13						7225 01			Final	1.00	1			NOK
14						7919 01			STG2	2.00	2			NOK
15						7919 01			STG2	2.00	2			NOK
16						7919 01			STG2	2.00	2			NOK
17						7919 01			STG2	2.00	2			NOK
18						7919 01			Final	2.00	2			NOK
19						7919 01			Final	2.00	2			NOK
20						7245 01			Final	1.00	1			NOK
21						7225 01			STG1	1.00	1			NOK
22						7920 01			STG2	2.00	2			NOK
23						7920 01			Final	2.00	2			NOK
24						7920 01			STG2	2.00	2			NOK
25						7920 01			Final	2.00	2			NOK
26						7225 01			STG1	1.00	1			NOK
27						7226 01			Final	1.00	1			OK
28						7204 01			Final	2.00	2			NOK
29						7204 01			Final	2.00	2			NOK
30						7204 01			Final	2.00	2			NOK
31						7204 01			Final	2.00	2			NOK
32						7919 01			STG2	2.00	2			NOK
33						7919 01			STG2	2.00	2			NOK
34						7919 01			STG2	2.00	2			NOK
35						7919 01			STG2	2.00	2			NOK
36						7919 01			Final	2.00	2			NOK
37						7919 01			Final	2.00	2			NOK
38						7245 01			Final	1.00	1			NOK
39						7225 01			STG1	1.00	1			NOK
40						7204 01			Final	2.00	2			NOK
41						7204 01			Final	2.00	2			NOK
42						7204 01			Final	2.00	2			NOK
43						7204 01			Final	2.00	2			NOK
44						4227 01			STG3	2.00	2			NOK
45						4227 01			STG3	2.00	2			NOK
46						4235 01			STG3	2.00	2			NOK
47						7203 01			Final	2.00	2			NOK
48						7203 01			Final	2.00	2			NOK
49						7203 01			Final	2.00	2			NOK
50						7204 01			Final	2.00	2			NOK
51						7204 01			Final	2.00	2			NOK
52						7204 01			Final	2.00	2			NOK
53						7204 01			Final	2.00	2			NOK
54						7204 01			Final	2.00	2			NOK
55						7204 01			Final	2.00	2			NOK
56						5652 01			Final	2.00	2			NOK
57						5652 01			Final	2.00	2			NOK
58						5651 01			Final	2.00	2			NOK
59						5651 01			Final	2.00	2			NOK
60						4227 01			STG3	2.00	2			NOK
61						4235 01			STG3	2.00	2			NOK
62						4227 01			STG3	2.00	2			NOK
63						4235 01			STG3	2.00	2			NOK
64						7225 01			STG1	1.00	1			NOK
65						7919 01			STG2	2.00	2			NOK
66						7919 01			Final	2.00	2			NOK
Screwpoints

 

[kirankoushik]

Just to test, I deleted 3 NOK rows with finish as Final and ran the macro..

i was expecting 2 and 32 as result.. it gave me 4 and 30..

Sub Import()

Dim K As Long, KK As Long, K2 As Long, K3 As Long
Dim rRngVisible, rRow As Range

    Set dic = CreateObject("scripting.dictionary")
    dic.CompareMode = vbTextCompare
    With Sheets("Screwpoints").Range("A2").CurrentRegion
        Debug.Print .Address '<--
        .AutoFilter Field:=9, Criteria1:="Final", Operator:=xlFilterValues
        Set rRngVisible = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
        Debug.Print rRngVisible.Address '<--
    End With

    For Each rRow In rRngVisible.Rows
        dic(rRow.Cells(1, 6).Value) = Application.Max(dic(rRow.Cells(1, 6).Value), IIf(rRow.Cells(1, "J").Value = 0 And rRow.Cells(1, "K").Value = 0, 0, 1))
        dic(rRow.Cells(1, 6).Value & "~C42") = Application.Max(dic(rRow.Cells(1, 6).Value & "~C42"), IIf(rRow.Cells(1, "J").Value > 0 And rRow.Cells(1, "K").Value > 0, 0, 1))
        dic(rRow.Cells(1, 6).Value & "~C43") = dic(rRow.Cells(1, 6).Value & "~C43") + rRow.Cells(1, "J").Value
        dic(rRow.Cells(1, 6).Value & "~Count") = dic(rRow.Cells(1, 6).Value & "~Count") + 1
        dic(rRow.Cells(1, 6).Value & "~C44") = rRow.Cells(1, "K").Value
    Next rRow

    Sheets("Total").Range("C40").Value = dic.Count / 5

    K = 0
    KK = 0
    K3 = 0
    k4 = 0

    For Each itm In dic
        If Right(itm, 4) = "~C42" Then
            KK = KK + IIf(dic(itm) = 0, 1, 0)
        ElseIf Right(itm, 4) = "~C44" Then
            k4 = k4 + IIf(dic(Left(itm, Len(itm) - 4) & "~C43") <> dic(Left(itm, Len(itm) - 4) & "~C44") Or dic(Left(itm, Len(itm) - 4) & "~C43") = 0 Or dic(Left(itm, Len(itm) - 4) & "~C44") = 0, dic(Left(itm, Len(itm) - 4) & "~Count"), 0)
        ElseIf Right(itm, 4) = "~C43" Then
            K3 = K3 + IIf(dic(itm) = dic(Left(itm, Len(itm) - 4) & "~C44") And dic(itm) <> 0, dic(Left(itm, Len(itm) - 4) & "~Count"), 0)
        Else
            K = K + IIf(dic(itm) = 0, 1, 0)
        End If
    Next itm

    Sheets("Total").Range("C41").Value = K
    Sheets("Total").Range("C42").Value = KK
    Sheets("Total").Range("C43").Value = K3
    Sheets("Total").Range("C44").Value = k4
    K = 0
    KK = 0
    K3 = 0
    k4 = 0

End Sub

 

[aRandomHelper]

The code is also picking up this line as 'OK'

Book1.xlsm
	F	G	H	I	J	K	L	M	N
2	screwcase	g	h	Finish	Total per set	Total per case	PDM	KS & DV	Result
12	7225 01			STG1	1	1			NOK
13	7225 01			Final	1	1			NOK
21	7225 01			STG1	1	1			NOK
26	7225 01			STG1	1	1			NOK
39	7225 01			STG1	1	1			NOK
64	7225 01			STG1	1	1			NOK
Sheet7

Since when you filter to "Final" there's only 1 entry of that, and columns J/K matches.

i was expecting 2 and 32 as result.. it gave me 4 and 30..

When you delete some rows, you also reduce the "Total per set", this may in turn result to some rows' column J sum now matching column K number.

 

[kirankoushik]

The code is also picking up this line as 'OK'

If the code is picking up first line as OK, then the total should be increased by one line..

Set rRngVisible = .Offset(1).Resize(.Rows.Count [B]- 1[/B]).SpecialCells(xlCellTypeVisible)

Is this part of the code (-1) removing the last line from the count instead of removing the header ? i just had a doubt

Since when you filter to "Final" there's only 1 entry of that, and columns J/K matches.

in sample sheet, there are two entries like that right ?

row number 4 and row number 27

When you delete some rows, you also reduce the "Total per set", this may in turn result to some rows' column J sum now matching column K number.

ah yes, ur right.. understood this part.. thanks..

I had to calculate ok / nok again after deleting 3 rows.. instead of expecting 2 and 32..

Manual calc shows the answer should have been 3 and 31 instead of 4 and 30..

if the header is counted as OK line.. that should not reduce 31 to 30 right ?

 

[kirankoushik]

Set rRngVisible = .Offset(1).Resize(.Rows.Count [B]- 1[/B]).SpecialCells(xlCellTypeVisible)

I just removed (-1) from this code.. it is counting header as OK line and the NOK values are showing correctly

 

[aRandomHelper]

There is nothing wrong with the -1. It should be ignoring the header row as expected. To understand better, you should break it into parts and see what range they represent.

    With Sheets("Screwpoints").Range("A2").CurrentRegion
        Debug.Print .Address
        Debug.Print .Offset(1).Address
        Debug.Print .Offset(1).Resize(.Rows.Count - 1).Address

in sample sheet, there are two entries like that right ?

row number 4 and row number 27

There is also row 13, like I shown on my previous post. Your formula is probably wrong, marking it as "NOK", but if you filter to only "Final" rows, row 13 should be "OK".

 

[kirankoushik]

There is nothing wrong with the -1. It should be ignoring the header row as expected. To understand better, you should break it into parts and see what range they represent.

    With Sheets("Screwpoints").Range("A2").CurrentRegion
        Debug.Print .Address
        Debug.Print .Offset(1).Address
        Debug.Print .Offset(1).Resize(.Rows.Count - 1).Address

There is also row 13, like I shown on my previous post. Your formula is probably wrong, marking it as "NOK", but if you filter to only "Final" rows, row 13 should be "OK".

God.. I feel stupid.. lol

I have no words to thank you enough..

your code is perfect, my calculation was wrong as i assigned OK/NOK before and then counted after the filter..
should have set filter first and then counted OK/NOK..

My good man, I owe you a drink.. thanks a ton.. ? ??