Dictionary For loop with Multiple If and range

K

kirankoushik

New Member
Joined
Feb 19, 2021
Messages
44
Office Version
  1. 2016
Platform
  1. Windows
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.

VBA Code: 
    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
 
Sort by date Sort by votes
aRandomHelper said:
When I have more time I'll try to break it down and explain.

See if this works as intended:
VBA Code: 
    dic.CompareMode = vbTextCompare
    With Sheets("ScrewPoints").Range("A2").CurrentRegion
        Set rRngVisible = .Offset(1).Resize(.Rows.Count - 1)
    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, "AG").Value = 0 And rRow.Cells(1, "AH").Value = 0, 0, 1))
        dic(rRow.Cells(1, 6).Value & "~C42") = Application.Max(dic(rRow.Cells(1, 6).Value & "~C42"), IIf(rRow.Cells(1, "AG").Value > 0 And rRow.Cells(1, "AH").Value > 0, 0, 1))
    Next rRow
  
    Sheets("Total").Range("C40").Value = dic.Count / 2
  
    k = 0
    kk = 0
  
    For Each itm In dic
        If right(itm, 4) = "~C42" then
            kk = kk + IIf(dic(itm) = 0, 1, 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
    k = 0
    kk = 0
Click to expand...
Thank you
 
Upvote 0

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Hi Kiran, I have added some comments below to try to explain how the code worked. Hope it helps.


VBA Code: 
    dic.CompareMode = vbTextCompare
    With Sheets("ScrewPoints").Range("A2").CurrentRegion
        Set rRngVisible = .Offset(1).Resize(.Rows.Count - 1)
    End With
 
    For Each rRow In rRngVisible.Rows
'each row's unique key --> rRow.Cells(1, 6).Value <-- is set to a default value of 0, this is stored in the dictionary
'if both values in AG/AH are 0, we keep it as 0, and Application.Max(0, 0) gives 0
'if either value is not 0, we mark it as 1, and Application.Max(0, 1) now gives 1 --> this unique Key is now marked as "1"
'when there's another of this unique key down the rows found, no matter AG/AH values, Application.Max(1, 0/1) will always give 1 now
        dic(rRow.Cells(1, 6).Value) = Application.Max(dic(rRow.Cells(1, 6).Value), IIf(rRow.Cells(1, "AG").Value = 0 And rRow.Cells(1, "AH").Value = 0, 0, 1))

'same logic for result in C42, except we manually create a separate unique Key with the added "~C42", this string can be anything else as well
'instead of AG/AH must be 0, the condition is now >0, but the logic still works the same
        dic(rRow.Cells(1, 6).Value & "~C42") = Application.Max(dic(rRow.Cells(1, 6).Value & "~C42"), IIf(rRow.Cells(1, "AG").Value > 0 And rRow.Cells(1, "AH").Value > 0, 0, 1))
    Next rRow

'since we have double unique Keys for each row, we divide by 2 for the count
    Sheets("Total").Range("C40").Value = dic.Count / 2
 
    k = 0
    kk = 0
 
    For Each itm In dic
        If right(itm, 4) = "~C42" then
'here when we take the value stored in the dictionary for each unique Key, the value is either 0 or 1, determined by the loop above
'based on the above logic, when "1" is being stored it means there was either a value in AG or AH that was not 0, means we ignore this unique Key
'if the stored value remained as "0", it means this unique Key has all rows with value 0 (or >0) in AG/AH, so we add it to the counter k or kk, depending on which key is it.
            kk = kk + IIf(dic(itm) = 0, 1, 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
    k = 0
    kk = 0
 
Upvote 0
aRandomHelper said:
Hi Kiran, I have added some comments below to try to explain how the code worked. Hope it helps.


VBA Code: 
    dic.CompareMode = vbTextCompare
    With Sheets("ScrewPoints").Range("A2").CurrentRegion
        Set rRngVisible = .Offset(1).Resize(.Rows.Count - 1)
    End With

    For Each rRow In rRngVisible.Rows
'each row's unique key --> rRow.Cells(1, 6).Value <-- is set to a default value of 0, this is stored in the dictionary
'if both values in AG/AH are 0, we keep it as 0, and Application.Max(0, 0) gives 0
'if either value is not 0, we mark it as 1, and Application.Max(0, 1) now gives 1 --> this unique Key is now marked as "1"
'when there's another of this unique key down the rows found, no matter AG/AH values, Application.Max(1, 0/1) will always give 1 now
        dic(rRow.Cells(1, 6).Value) = Application.Max(dic(rRow.Cells(1, 6).Value), IIf(rRow.Cells(1, "AG").Value = 0 And rRow.Cells(1, "AH").Value = 0, 0, 1))

'same logic for result in C42, except we manually create a separate unique Key with the added "~C42", this string can be anything else as well
'instead of AG/AH must be 0, the condition is now >0, but the logic still works the same
        dic(rRow.Cells(1, 6).Value & "~C42") = Application.Max(dic(rRow.Cells(1, 6).Value & "~C42"), IIf(rRow.Cells(1, "AG").Value > 0 And rRow.Cells(1, "AH").Value > 0, 0, 1))
    Next rRow

'since we have double unique Keys for each row, we divide by 2 for the count
    Sheets("Total").Range("C40").Value = dic.Count / 2

    k = 0
    kk = 0

    For Each itm In dic
        If right(itm, 4) = "~C42" then
'here when we take the value stored in the dictionary for each unique Key, the value is either 0 or 1, determined by the loop above
'based on the above logic, when "1" is being stored it means there was either a value in AG or AH that was not 0, means we ignore this unique Key
'if the stored value remained as "0", it means this unique Key has all rows with value 0 (or >0) in AG/AH, so we add it to the counter k or kk, depending on which key is it.
            kk = kk + IIf(dic(itm) = 0, 1, 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
    k = 0
    kk = 0
Click to expand...

Thank you very much for the detailed explanation.. ?

I am having a doubt in one concept.. are the dictionary keys now filled with only 0's and 1's ?

why I ask is.. in the following lines c43, c44.. I need to cross check the total from column AG v/s if all the values in AH are same.

1. all rows in column AH are same
2. all rows in column AG - summation = single value in AH
3. screw case column F should not be blank
4. Total ok = 3 not 2 ( even though one of the screw case is repeated twice)

please excuse me if I had to post it as another thread.,
 

Attachments

  • dict.PNG
    dict.PNG
    13 KB · Views: 7
Upvote 0
kirankoushik said:
I am having a doubt in one concept.. are the dictionary keys now filled with only 0's and 1's ?
Click to expand...
The Keys would be "1234 01" / "1234 01~C42", etc. based on your sample screenshot. The 0's and 1's are the stored value / Items.

kirankoushik said:
in the following lines c43, c44.. I need to cross check the total from column AG v/s if all the values in AH are same.
Click to expand...
So based on your example, what should be shown in c43 and what should be shown in c44?

kirankoushik said:
1. all rows in column AH are same
2. all rows in column AG - summation = single value in AH
3. screw case column F should not be blank
4. Total ok = 3 not 2 ( even though one of the screw case is repeated twice)
Click to expand...
I think I understand what you mean, but not sure what should be put in c43/c44
 
Upvote 0
Can you try this?

VBA Code: 
    dic.CompareMode = vbTextCompare
    With Sheets("ScrewPoints").Range("A2").CurrentRegion
        Set rRngVisible = .Offset(1).Resize(.Rows.Count - 1)
    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, "AG").Value = 0 And rRow.Cells(1, "AH").Value = 0, 0, 1))
        dic(rRow.Cells(1, 6).Value & "~C42") = Application.Max(dic(rRow.Cells(1, 6).Value & "~C42"), IIf(rRow.Cells(1, "AG").Value > 0 And rRow.Cells(1, "AH").Value > 0, 0, 1))
        dic(rRow.Cells(1, 6).Value & "~C43") = dic(rRow.Cells(1, 6).Value & "~C43") + rRow.Cells(1, "AG").Value
        If Not dic.exists(dic(rRow.Cells(1, 6).Value & "~C44")) Then
            dic(rRow.Cells(1, 6).Value & "~C44") = rRow.Cells(1, "AH").Value
        Else
            If dic(rRow.Cells(1, 6).Value & "~C44") <> "NOK" And dic(rRow.Cells(1, 6).Value & "~C44") <> rRow.Cells(1, "AH").Value Then dic(rRow.Cells(1, 6).Value & "~C44") = "NOK"
        End If
    Next rRow
  
    Sheets("Total").Range("C40").Value = dic.Count / 4
  
    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(itm) = "NOK", 1, 0)
        ElseIf Right(itm, 4) = "~C43" Then
            k3 = k3 + IIf(dic(itm) = dic(Left(itm, Len(itm) - 4) & "~C44"), 1, 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
 
Upvote 0
aRandomHelper said:
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(itm) = "NOK", 1, 0)
ElseIf Right(itm, 4) = "~C43" Then
k3 = k3 + IIf(dic(itm) = dic(Left(itm, Len(itm) - 4) & "~C44"), 1, 0)
Else
k = k + IIf(dic(itm) = 0, 1, 0)
End If
Next itm
Click to expand...

Hi, Isn't this populating the list from the dictionary and neglecting duplicate entries?

VBA Code: 
4. Total ok = 3 not 2 ( even though one of the screw case is repeated twice)

I meant to ask it is counting 2 and not 3 right ?
 
Upvote 0
Try:
VBA Code: 
    dic.CompareMode = vbTextCompare
    With Sheets("ScrewPoints").Range("A2").CurrentRegion
        Set rRngVisible = .Offset(1).Resize(.Rows.Count - 1)
    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, "AG").Value = 0 And rRow.Cells(1, "AH").Value = 0, 0, 1))
        dic(rRow.Cells(1, 6).Value & "~C42") = Application.Max(dic(rRow.Cells(1, 6).Value & "~C42"), IIf(rRow.Cells(1, "AG").Value > 0 And rRow.Cells(1, "AH").Value > 0, 0, 1))
        dic(rRow.Cells(1, 6).Value & "~C43") = dic(rRow.Cells(1, 6).Value & "~C43") + rRow.Cells(1, "AG").Value
        dic(rRow.Cells(1, 6).Value & "~Count") = dic(rRow.Cells(1, 6).Value & "~Count") + 1
        If Not dic.exists(dic(rRow.Cells(1, 6).Value & "~C44")) Then
            dic(rRow.Cells(1, 6).Value & "~C44") = rRow.Cells(1, "AH").Value
        Else
            If dic(rRow.Cells(1, 6).Value & "~C44") <> "NOK" And dic(rRow.Cells(1, 6).Value & "~C44") <> rRow.Cells(1, "AH").Value Then dic(rRow.Cells(1, 6).Value & "~C44") = "NOK"
        End If
    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(itm) = "NOK", 1, 0)
        ElseIf Right(itm, 4) = "~C43" Then
            k3 = k3 + IIf(dic(itm) = dic(Left(itm, Len(itm) - 4) & "~C44"), 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

If it still doesn't work as intended, I need to see some sample data. It's quite hard to imagine or base it entirely from your screenshot. Use XL2BB to share your sheet and I can easily copy/paste into Excel.
 
Upvote 0
aRandomHelper said:
Try:
If it still doesn't work as intended, I need to see some sample data. It's quite hard to imagine or base it entirely from your screenshot. Use XL2BB to share your sheet and I can easily copy/paste into Excel.
Click to expand...

Sry, it still gives me the result by counting only once instead of every line. The page I am working with has around 1800 entries. I have pasted a small part here. Please let me know if you need the complete sheet. Also, the Columns AG & AH, I've moved to J & K for ease..

report.xlsx
ABCDEFGHIJKLM
2screwcaseFinishTotal per setTotal per casePDMKS & DV
35282 01Final0.000
47238 01Final1.001
57206 01Final0.000
65638 01STG11.001
75638 01STG11.001
87919 01STG22.002
97919 01Final2.002
107919 01STG22.002
117919 01Final2.002
127225 01STG11.001
137225 01Final1.001
147919 01STG22.002
157919 01STG22.002
167919 01STG22.002
177919 01STG22.002
187919 01Final2.002
197919 01Final2.002
207245 01Final1.001
217225 01STG11.001
227920 01STG22.002
237920 01Final2.002
247920 01STG22.002
257920 01Final2.002
267225 01STG11.001
277226 01Final1.001
287204 01Final2.002
297204 01Final2.002
307204 01Final2.002
317204 01Final2.002
327919 01STG22.002
337919 01STG22.002
347919 01STG22.002
357919 01STG22.002
367919 01Final2.002
377919 01Final2.002
387245 01Final1.001
397225 01STG11.001
407204 01Final2.002
417204 01Final2.002
427204 01Final2.002
437204 01Final2.002
444227 01STG32.002
454227 01STG32.002
464235 01STG32.002
477203 01Final2.002
487203 01Final2.002
497203 01Final2.002
507204 01Final2.002
517204 01Final2.002
527204 01Final2.002
537204 01Final2.002
547204 01Final2.002
557204 01Final2.002
565652 01Final2.002
575652 01Final2.002
585651 01Final2.002
595651 01Final2.002
604227 01STG32.002
614235 01STG32.002
624227 01STG32.002
634235 01STG32.002
647225 01STG11.001
657919 01STG22.002
667919 01Final2.002
screwpoints
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
VBA: Using Dictionary or Arrays to sum based on multiple columns?
Replies
7
Views
229
Coyotex3
C
J
  • Question
using sumifs function across multiple sheets
Replies
4
Views
265
KRice
K
P
  • Question
ListBox Click to textbox & delete row
Replies
0
Views
337
pure vito
P
E
  • Solved
Count unique values with 2 conditions
2
Replies
12
Views
623
Fluff
Fluff
P
  • Question
Turning OFF the visibility of a horizontal (category) axis labels if certain conditions apply
Replies
1
Views
418
NdNoviceHlp
NdNoviceHlp

Forum statistics

Threads
1,215,223
Messages
6,123,722
Members
449,116
Latest member
Aaagu

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