VBA to find unique from multiple columns and count on multiple criteria. Anybody please

Ombir

Ombir

Active Member
Joined
Oct 1, 2015
Messages
433
Hi friends,


I have a worksheet shown below.


ABCDEF
1DtSb1Sb2Sb3Sb4Sb5
2AmENCHICPOSECOCPU
3AmENCHICPOSMASMAT
4BwENCHICPOSECOCPU
5BwENCHOSPHECHEBIO
6JnENCHICPOSECOCPU
7JnENCHICPOSECOCPU
8JnENCHICMATOSHOSE

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Sheet3​




First I want to find Unique values based on Column 1 and Column(2-6) then count these values as shown below.

HIJ
1DtSbCnt
2AmENC2
3AmHIC2
4AmPOS2
5AmECO1
6AmCPU1
7AmMAS1
8AmMAT1
9BwENC2
10BwHIC1
11BwPOS1
12BwPHE1
13BwECO1
14BwCPU1
15BwCHE2
16BwBIO1
17JnENC3
18JnHIC3
19JnPOS2
20JnECO2
21JnCPU2
22JnMAT1
23JnOSH1
24JnOSE1

<colgroup><col style="width: 25pxpx"><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Sheet3​


I am able to code this in Visual Fox Pro but can anybody help me with some VBA code to achieve this. Thanks
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Sort by date Sort by votes
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG27Dec39
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, Q [COLOR="Navy"]As[/COLOR] Variant
Ray = Range("a1").CurrentRegion.Resize(, 6)
ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 3)
nray(1, 1) = "Dt": nray(1, 2) = "Sb": nray(1, 3) = "Cnt"
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
n = 1


[COLOR="Navy"]For[/COLOR] Rw = 2 To UBound(Ray, 1)
    [COLOR="Navy"]For[/COLOR] Ac = 2 To UBound(Ray, 2)
        [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Ray(Rw, 1) & Ray(Rw, Ac)) [COLOR="Navy"]Then[/COLOR]
            n = n + 1
            nray(n, 1) = Ray(Rw, 1): nray(n, 2) = Ray(Rw, Ac): nray(n, 3) = 1
            Dic.Add Ray(Rw, 1) & Ray(Rw, Ac), Array(n, 1)
        [COLOR="Navy"]Else[/COLOR]
            Q = Dic(Ray(Rw, 1) & Ray(Rw, Ac))
                Q(1) = Q(1) + 1
                nray(Q(0), 3) = Q(1)
           Dic(Ray(Rw, 1) & Ray(Rw, Ac)) = Q
        
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] Rw
Range("H1").Resize(n, 3) = nray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
Try this:-
Code: 
[COLOR=Navy]Sub[/COLOR] MG27Dec39
[COLOR=Navy]Dim[/COLOR] Ray [COLOR=Navy]As[/COLOR] Variant, Rw [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Ac [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Dic [COLOR=Navy]As[/COLOR] Object, Q [COLOR=Navy]As[/COLOR] Variant
Ray = Range("a1").CurrentRegion.Resize(, 6)
ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 3)
nray(1, 1) = "Dt": nray(1, 2) = "Sb": nray(1, 3) = "Cnt"
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
n = 1


[COLOR=Navy]For[/COLOR] Rw = 2 To UBound(Ray, 1)
    [COLOR=Navy]For[/COLOR] Ac = 2 To UBound(Ray, 2)
        [COLOR=Navy]If[/COLOR] Not Dic.Exists(Ray(Rw, 1) & Ray(Rw, Ac)) [COLOR=Navy]Then[/COLOR]
            n = n + 1
            nray(n, 1) = Ray(Rw, 1): nray(n, 2) = Ray(Rw, Ac): nray(n, 3) = 1
            Dic.Add Ray(Rw, 1) & Ray(Rw, Ac), Array(n, 1)
        [COLOR=Navy]Else[/COLOR]
            Q = Dic(Ray(Rw, 1) & Ray(Rw, Ac))
                Q(1) = Q(1) + 1
                nray(Q(0), 3) = Q(1)
           Dic(Ray(Rw, 1) & Ray(Rw, Ac)) = Q
        
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] Ac
[COLOR=Navy]Next[/COLOR] Rw
Range("H1").Resize(n, 3) = nray
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub [/COLOR]
Regards Mick
Click to expand...

Thanks a lot Mick. This code is working fine. My gut was also telling me to use dictionary to achieve this but couldn't able to figure out the solution. I am trying to understand how this code is working but I am stuck at two things.

1. What this Array(n,1) is doing ?
2. How this else part of If is working

Code: 
Q = Dic(Ray(Rw, 1) & Ray(Rw, Ac))
                Q(1) = Q(1) + 1
                nray(Q(0), 3) = Q(1)
           Dic(Ray(Rw, 1) & Ray(Rw, Ac)) = Q

I am learning VBA so unable to understand this. Could you please explain about these two things. Thanks.
 
Upvote 0
Hopefully this "Remarked" code will Help.
Code: 
[COLOR=Navy]Sub[/COLOR] MG28Dec42
[COLOR=Navy]Dim[/COLOR] Ray [COLOR=Navy]As[/COLOR] Variant, Rw [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Ac [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Dic [COLOR=Navy]As[/COLOR] Object, Q [COLOR=Navy]As[/COLOR] Variant
Ray = Range("a1").CurrentRegion.Resize(, 6)
ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 3)
nray(1, 1) = "Dt": nray(1, 2) = "Sb": nray(1, 3) = "Cnt"
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
n = 1
'[COLOR=Green][B]If you familiar with "Scripting Dictionary" you will know it has[/B][/COLOR]
'[COLOR=Green][B]"Keys" and "Items" relating to those Keys:=[/B][/COLOR]
[COLOR=Navy]For[/COLOR] Rw = 2 To UBound(Ray, 1)
    [COLOR=Navy]For[/COLOR] Ac = 2 To UBound(Ray, 2)
        [COLOR=Navy]If[/COLOR] Not Dic.Exists(Ray(Rw, 1) & Ray(Rw, Ac)) [COLOR=Navy]Then[/COLOR]
           
           '[COLOR=Green][B]"n" represents the Index of every new Unique value in dictionary "Keys"[/B][/COLOR]
           '[COLOR=Green][B]This "n" value is used to define each new row in the results Array "nRay"[/B][/COLOR]
            n = n + 1
            '[COLOR=Green][B]Fill first Row of new Unique Results[/B][/COLOR]
            nray(n, 1) = Ray(Rw, 1): nray(n, 2) = Ray(Rw, Ac): nray(n, 3) = 1
            
            '[COLOR=Green][B]Array(n,1) is the "ITEM" of each unique value (KEY) found indata and[/B][/COLOR]
            '[COLOR=Green][B]represents the value "n" giving the row location of each new value placed in array "nRay" and[/B][/COLOR]
            '[COLOR=Green][B]"1" which is the first count of each unique value found[/B][/COLOR]
            '[COLOR=Green][B] This count is increases in the Else statement, below when another count of the[/B][/COLOR]
            '[COLOR=Green][B]same Unique value is found !![/B][/COLOR]
            Dic.Add Ray(Rw, 1) & Ray(Rw, Ac), Array(n, 1)
        
        [COLOR=Navy]Else[/COLOR]
           '[COLOR=Green][B] The variable "Q" is used to represent the "ITEM" of each Unique (KEY)[/B][/COLOR]
           '[COLOR=Green][B] so "Q" is the "ITEM" of the "KEY" :- Ray(Rw, 1) & Ray(Rw, Ac)[/B][/COLOR]
            Q = Dic(Ray(Rw, 1) & Ray(Rw, Ac))
                
           '[COLOR=Green][B]There are 2 values in "Q", "Q0" the first value "n" and "Q1" the count of each subsequent[/B][/COLOR]
           '[COLOR=Green][B]Unique value found[/B][/COLOR]
           '[COLOR=Green][B]That count is increased by 1 each time another value, for that unique "KEY" is found[/B][/COLOR]
                Q(1) = Q(1) + 1
            
            '[COLOR=Green][B]Column 3 of the Results array nRay is increased by 1[/B][/COLOR]
                nray(Q(0), 3) = Q(1)
           
           '[COLOR=Green][B]The item resulting to "Q" is updated.[/B][/COLOR]
           Dic(Ray(Rw, 1) & Ray(Rw, Ac)) = Q
        
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] Ac
[COLOR=Navy]Next[/COLOR] Rw
Range("H1").Resize(n, 3) = nray
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 
Upvote 0
Mick,

Thanks for the explanation above.

Just one question

why the resize on the current region?
 
Upvote 0
It just limits the array to 6 columns.
If the number of columns had been greater that 6 then the code will have looked at those extra columns when I used ubound(ray,2).
 
Upvote 0
Thanks, that makes sense.

I see you use scripting library quite often is this user preference or an absolute better way to go.

Is there a good learning place for the scripting library?
 
Upvote 0
Thanks Mick,

I like the fact the site is not discriminatory as well.

It says VBA for smarties but let me in anyway
 
Upvote 0
MickG said:
Hopefully this "Remarked" code will Help.
Code: 
[COLOR=Navy]Sub[/COLOR] MG28Dec42
[COLOR=Navy]Dim[/COLOR] Ray [COLOR=Navy]As[/COLOR] Variant, Rw [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Ac [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Dic [COLOR=Navy]As[/COLOR] Object, Q [COLOR=Navy]As[/COLOR] Variant
Ray = Range("a1").CurrentRegion.Resize(, 6)
ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 3)
nray(1, 1) = "Dt": nray(1, 2) = "Sb": nray(1, 3) = "Cnt"
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
n = 1
'[COLOR=Green][B]If you familiar with "Scripting Dictionary" you will know it has[/B][/COLOR]
'[COLOR=Green][B]"Keys" and "Items" relating to those Keys:=[/B][/COLOR]
[COLOR=Navy]For[/COLOR] Rw = 2 To UBound(Ray, 1)
    [COLOR=Navy]For[/COLOR] Ac = 2 To UBound(Ray, 2)
        [COLOR=Navy]If[/COLOR] Not Dic.Exists(Ray(Rw, 1) & Ray(Rw, Ac)) [COLOR=Navy]Then[/COLOR]
           
           '[COLOR=Green][B]"n" represents the Index of every new Unique value in dictionary "Keys"[/B][/COLOR]
           '[COLOR=Green][B]This "n" value is used to define each new row in the results Array "nRay"[/B][/COLOR]
            n = n + 1
            '[COLOR=Green][B]Fill first Row of new Unique Results[/B][/COLOR]
            nray(n, 1) = Ray(Rw, 1): nray(n, 2) = Ray(Rw, Ac): nray(n, 3) = 1
            
            '[COLOR=Green][B]Array(n,1) is the "ITEM" of each unique value (KEY) found indata and[/B][/COLOR]
            '[COLOR=Green][B]represents the value "n" giving the row location of each new value placed in array "nRay" and[/B][/COLOR]
            '[COLOR=Green][B]"1" which is the first count of each unique value found[/B][/COLOR]
            '[COLOR=Green][B] This count is increases in the Else statement, below when another count of the[/B][/COLOR]
            '[COLOR=Green][B]same Unique value is found !![/B][/COLOR]
            Dic.Add Ray(Rw, 1) & Ray(Rw, Ac), Array(n, 1)
        
        [COLOR=Navy]Else[/COLOR]
           '[COLOR=Green][B] The variable "Q" is used to represent the "ITEM" of each Unique (KEY)[/B][/COLOR]
           '[COLOR=Green][B] so "Q" is the "ITEM" of the "KEY" :- Ray(Rw, 1) & Ray(Rw, Ac)[/B][/COLOR]
            Q = Dic(Ray(Rw, 1) & Ray(Rw, Ac))
                
           '[COLOR=Green][B]There are 2 values in "Q", "Q0" the first value "n" and "Q1" the count of each subsequent[/B][/COLOR]
           '[COLOR=Green][B]Unique value found[/B][/COLOR]
           '[COLOR=Green][B]That count is increased by 1 each time another value, for that unique "KEY" is found[/B][/COLOR]
                Q(1) = Q(1) + 1
            
            '[COLOR=Green][B]Column 3 of the Results array nRay is increased by 1[/B][/COLOR]
                nray(Q(0), 3) = Q(1)
           
           '[COLOR=Green][B]The item resulting to "Q" is updated.[/B][/COLOR]
           Dic(Ray(Rw, 1) & Ray(Rw, Ac)) = Q
        
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] Ac
[COLOR=Navy]Next[/COLOR] Rw
Range("H1").Resize(n, 3) = nray
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...

Thanks for the explanation Mick. Now I am getting a clear picture of this code but still have few doubts.

1. How this code is identifying that Q will contain 2 values. You have declared it as variant but dimension is not available.
2. For first iteration of any key in else statement Q(1) is calculating count of 2 but initial value of Q(1) is not declared as 1. Is it taking initial value as 1 by default ?
3. Is there any link between Array(n,1) and Q ?
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question
Formula to count with multiple criteria and exclude from a separate column, then sort by count in one cell with spill
Replies
0
Views
365
Greenbehindthecells
G
darrenmccoy
  • Question
Help to Index unique records in Multiple columns
2
Replies
11
Views
1K
Peter_SSs
Peter_SSs
D
  • Question
Search for multiple values w/ one criteria but show unique values only
Replies
5
Views
590
sandy666
sandy666
P
  • Question
Count unique value comparing multiple coloumn
Replies
2
Views
514
DanteAmor
DanteAmor
M
  • Question
Count Unique Values That Meet Criteria
Replies
2
Views
572
masouder
M

Forum statistics

Threads
1,215,892
Messages
6,127,610
Members
449,389
Latest member
ChessManNaill

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