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

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
aRandomHelper said:
This small sample is good enough, but can you tell me what should be the expected numbers for this set of data? It seems there are no cases like below criteria:
Click to expand...

expected numbers for the data set in image :

Total OK Count = 3
Total NOK count = 7
 

Attachments

  • dict.PNG
    dict.PNG
    13 KB · Views: 6
Upvote 0
aRandomHelper said:
This small sample is good enough, but can you tell me what should be the expected numbers for this set of data? It seems there are no cases like below criteria:
Click to expand...

2. all rows in column AG (summation) = single value in AH

If this criteria is not met, the status is set to NOK.

edit:

all rows in column AG :-

By this I mean when screwcase filter is applied in column 6 i.e. per screw case.. I am checking all the rows..
 
Upvote 0
I have shown the manual calculations for the sample excel data I shared.

Please see if it is useful in understanding what I am trying to convey.
 

Attachments

  • ExcelResults.PNG
    ExcelResults.PNG
    34.4 KB · Views: 8
Upvote 0
Didn't have time to look at it the past few days.

Try this amended code:
VBA Code: 
    Set dic = CreateObject("scripting.dictionary")
    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
        dic(rRow.Cells(1, 6).Value & "~C44") = rRow.Cells(1, "AH").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
 
Upvote 0
Solution
aRandomHelper said:
Didn't have time to look at it the past few days.

Try this amended code:
VBA Code: 
    Set dic = CreateObject("scripting.dictionary")
    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
        dic(rRow.Cells(1, 6).Value & "~C44") = rRow.Cells(1, "AH").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
Click to expand...

Thanks (y), this works perfectly..

could you please explain with comments also ?

the client says I need to check row I also for status Final now.. i am trying to understand the logic and extend the status check to same code..
 
Upvote 0
I am trying to add:
AutoFilter Field:=9, Criteria1:="Final" while setting the range so that any calculating taking place is already defined by visible rows after auto filter..
 
Upvote 0
aRandomHelper said:
Didn't have time to look at it the past few days.

Try this amended code:
VBA Code: 
    Set dic = CreateObject("scripting.dictionary")
    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
        dic(rRow.Cells(1, 6).Value & "~C44") = rRow.Cells(1, "AH").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
Click to expand...

i am finding it quite difficult to understand the code..

that leaves me thinking if the dictionary approach is the right way..

the advantage i see with a simple code is I can make the necessary changes at my end as and when my client gives new input..

any help is appreciated.. thanks..
 
Upvote 0
If you need to set the range to only visible rows you can try this:

VBA Code: 
    With Sheets("ScrewPoints").Range("A2").CurrentRegion
        Set rRngVisible = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlcelltypevisible)
    End With
I did not include that part since it wasn't in your original code.

kirankoushik said:
i am finding it quite difficult to understand the code..

that leaves me thinking if the dictionary approach is the right way..
Click to expand...
Dictionary is basically a very versatile version of array, and it works very suitably when you need to deal with unique keys like in your case.
If it's difficult to understand, then break it into small parts and/or do a step through the code to understand what each line is doing.

kirankoushik said:
the advantage i see with a simple code is I can make the necessary changes at my end as and when my client gives new input..
Click to expand...
To be frank, it is already quite simple. It only appear confusing/complex because of the requirements itself. If you want to code it in a "simpler" way, using multiple Dictionary objects might make it slightly more readable. Do some of your own practice coding with Dictionaries, it's pretty fun and should be quite easy to pick up.
 
Upvote 0
aRandomHelper said:
If you need to set the range to only visible rows you can try this:

VBA Code: 
    With Sheets("ScrewPoints").Range("A2").CurrentRegion
        Set rRngVisible = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlcelltypevisible)
    End With
I did not include that part since it wasn't in your original code.
Click to expand...

actually I googled and tried the same thing.. instead of 2 and 62, I am getting the answer as 3 and 73..

I also tried xlNumbers, xlConstants etc.. nothing seems to give the answer 2 and 35 : /

edit:

when I don't add " SpecialCells(xlCellTypeVisible) "

the result is correct as expected 2 and 62
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question
Formula not working
Replies
1
Views
100
RoryA
RoryA
C
  • Solved
VBA: Using Dictionary or Arrays to sum based on multiple columns?
Replies
7
Views
259
Coyotex3
C
J
  • Question
using sumifs function across multiple sheets
Replies
4
Views
286
KRice
K
P
  • Question
ListBox Click to textbox & delete row
Replies
0
Views
374
pure vito
P
E
  • Solved
Count unique values with 2 conditions
2
Replies
12
Views
673
Fluff
Fluff

Forum statistics

Threads
1,216,168
Messages
6,129,268
Members
449,497
Latest member
The Wamp

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