Count unique values upon three criteria

P

premvinoth

New Member
Joined
Aug 4, 2015
Messages
16
Hi,

I have about 1,500 rows of data as mentioned below. Everyday I would need to prepare a report for the previous 3 days. (That file contains only previous 3 days data). For each date, for each of the dealer, i need to count the product and generate a report as shown at the bottom...
[TABLE="class: outer_border, width: 500, align: left"]
<tbody>[TR]
[TD]Date[/TD]
[TD]Dealer[/TD]
[TD]Product[/TD]
[/TR]
[TR]
[TD]08/03/2015[/TD]
[TD]Dealer A[/TD]
[TD]Mobile phone[/TD]
[/TR]
[TR]
[TD]08/03/2015[/TD]
[TD]Dealer A[/TD]
[TD]Watch[/TD]
[/TR]
[TR]
[TD]08/03/2015[/TD]
[TD]Dealer A [/TD]
[TD]Mobile Phone[/TD]
[/TR]
[TR]
[TD]08/03/2015[/TD]
[TD]Dealer A[/TD]
[TD]Laptop[/TD]
[/TR]
[TR]
[TD]08/03/2015[/TD]
[TD]Dealer A[/TD]
[TD]Laptop[/TD]
[/TR]
[TR]
[TD]08/03/2015[/TD]
[TD]Dealer A[/TD]
[TD]Mobile Phone[/TD]
[/TR]
[TR]
[TD]08/02/2015[/TD]
[TD]Dealer A[/TD]
[TD]Laptop [/TD]
[/TR]
[TR]
[TD]08/02/2015[/TD]
[TD]Dealer A[/TD]
[TD]Watch[/TD]
[/TR]
[TR]
[TD]08/02/2015[/TD]
[TD]Dealer A[/TD]
[TD]Watch[/TD]
[/TR]
[TR]
[TD]08/01/2015[/TD]
[TD]Dealer A[/TD]
[TD]Mobile phone[/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="class: grid, width: 800"]
<tbody>[TR]
[TD]Dealer[/TD]
[TD]Dealer total count[/TD]
[TD]Day1 count[/TD]
[TD]Day1 product wise count[/TD]
[TD]Day2 count[/TD]
[TD]Day2 product wise count[/TD]
[TD]Day3 count[/TD]
[TD]Day3 product wise count[/TD]
[/TR]
[TR]
[TD]Dealer A[/TD]
[TD]10[/TD]
[TD]6[/TD]
[TD]3-Mobile phone, 2-Laptop, 1-Watch[/TD]
[TD]3[/TD]
[TD]2-Watch, 1-Laptop[/TD]
[TD]1[/TD]
[TD]1-Mobile phone[/TD]
[/TR]
</tbody>[/TABLE]

The product wise count needs to be in a descending order based on the count. Show here is sample data for one dealer (Dealer A), there are 10 dealers in the dataset, and this similar report needs to be generated in a single sheet.

I would highly appreciate your support in automating it in VBA. Thank you in advance.

Regards,
Vinoth
 
Sort by date Sort by votes
Try this for Data on sheet 1 and Results sheet 2.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG05Aug18
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Dic [COLOR="Navy"]As[/COLOR] Object, Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant, p [COLOR="Navy"]As[/COLOR] Variant, g [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] y [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("B2"), .Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
  ReDim ray(1 To Rng.Count, 1 To Rng.Count)


[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
      [COLOR="Navy"]End[/COLOR] If
      
       [COLOR="Navy"]If[/COLOR] Not Dic(Dn.Value).exists(Dn.Offset(, -1).Value) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value)(Dn.Offset(, -1).Value) = CreateObject("Scripting.Dictionary")
                        Dic(Dn.Value)(Dn.Offset(, -1).Value).CompareMode = 1
       [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]If[/COLOR] Not Dic(Dn.Value)(Dn.Offset(, -1).Value).exists(Dn.Offset(, 1).Value) [COLOR="Navy"]Then[/COLOR]
                  Dic(Dn.Value)(Dn.Offset(, -1).Value).Add (Dn.Offset(, 1).Value), 1
            [COLOR="Navy"]Else[/COLOR]
                    Dic(Dn.Value)(Dn.Offset(, -1).Value).Item(Dn.Offset(, 1).Value) = _
                    Dic(Dn.Value)(Dn.Offset(, -1).Value).Item(Dn.Offset(, 1).Value) + 1
            [COLOR="Navy"]End[/COLOR] If
                  
[COLOR="Navy"]Next[/COLOR] Dn
   
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
   ac = 3: c = c + 1: y = 0
     [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k).Keys
         y = y + 1
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] g [COLOR="Navy"]In[/COLOR] Dic(k)(p).Keys
                ray(1, 1) = "Dealer": ray(1, 2) = "Dealer Total"
                ray(1, ac) = "Day" & y & " " & "Count"
                ray(1, ac + 1) = "Day" & y & " " & "Prouduct Wise Count"
                ray(c, 1) = k
                ray(c, 2) = Application.CountIf(Rng, k)
                ray(c, ac) = ray(c, ac) + Dic(k)(p)(g)
                ray(c, ac + 1) = ray(c, ac + 1) & "," & Dic(k)(p)(g) & "-" & g
                [COLOR="Navy"]If[/COLOR] Left(ray(c, ac + 1), 1) = "," [COLOR="Navy"]Then[/COLOR] ray(c, ac + 1) = Mid((Dic(k)(p)(g) & "-" & g), 1)
            [COLOR="Navy"]Next[/COLOR] g
      ac = ac + 2
     oMax = Application.Max(oMax, ac)
     [COLOR="Navy"]Next[/COLOR] p
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, oMax - 1)
    .Value = ray
    .Columns.AutoFit
    .Borders.Weight = 2
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi Mick,

Many thanks to you.. it is working amazing.

Is is possible to make the contents in the "Product wise count" to be listed in a order like 'Products with highest count on the first and least count on the last' (Descending order).

Once again thank you for your precious time.

Regards,
Vinoth
 
Upvote 0
Perhaps this ?? :-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG05Aug34
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Dic [COLOR="Navy"]As[/COLOR] Object, Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant, p [COLOR="Navy"]As[/COLOR] Variant, g [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] y [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant, i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] j [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
    [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("B2"), .Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
  ReDim Ray(1 To Rng.Count, 1 To Rng.Count)


[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
      [COLOR="Navy"]End[/COLOR] If
      
       [COLOR="Navy"]If[/COLOR] Not Dic(Dn.Value).exists(Dn.Offset(, -1).Value) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value)(Dn.Offset(, -1).Value) = CreateObject("Scripting.Dictionary")
                        Dic(Dn.Value)(Dn.Offset(, -1).Value).CompareMode = 1
       [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]If[/COLOR] Not Dic(Dn.Value)(Dn.Offset(, -1).Value).exists(Dn.Offset(, 1).Value) [COLOR="Navy"]Then[/COLOR]
                  Dic(Dn.Value)(Dn.Offset(, -1).Value).Add (Dn.Offset(, 1).Value), 1
            [COLOR="Navy"]Else[/COLOR]
                    Dic(Dn.Value)(Dn.Offset(, -1).Value).Item(Dn.Offset(, 1).Value) = _
                    Dic(Dn.Value)(Dn.Offset(, -1).Value).Item(Dn.Offset(, 1).Value) + 1
            [COLOR="Navy"]End[/COLOR] If
                  
[COLOR="Navy"]Next[/COLOR] Dn
   
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
   ac = 3: c = c + 1: y = 0
     [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k).Keys
         y = y + 1
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] g [COLOR="Navy"]In[/COLOR] Dic(k)(p).Keys
                Ray(1, 1) = "Dealer": Ray(1, 2) = "Dealer Total"
                Ray(1, ac) = "Day" & y & " " & "Count"
                Ray(1, ac + 1) = "Day" & y & " " & "Prouduct Wise Count"
                Ray(c, 1) = k
                Ray(c, 2) = Application.CountIf(Rng, k)
                Ray(c, ac) = Ray(c, ac) + Dic(k)(p)(g)
                Ray(c, ac + 1) = Ray(c, ac + 1) & "," & Dic(k)(p)(g) & "-" & g
                [COLOR="Navy"]If[/COLOR] Left(Ray(c, ac + 1), 1) = "," [COLOR="Navy"]Then[/COLOR] Ray(c, ac + 1) = Mid((Dic(k)(p)(g) & "-" & g), 1)
            [COLOR="Navy"]Next[/COLOR] g
      
      Sp = Split(Ray(c, ac + 1), ",")
      [COLOR="Navy"]If[/COLOR] UBound(Sp) > 0 [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]For[/COLOR] i = 0 To UBound(Sp) - 1
            [COLOR="Navy"]For[/COLOR] j = i To UBound(Sp)
                [COLOR="Navy"]If[/COLOR] Split(Sp(j), "-")(0) > Split(Sp(i), "-")(0) [COLOR="Navy"]Then[/COLOR]
                    temp = Sp(i)
                    Sp(i) = Sp(j)
                    Sp(j) = temp
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] j
        [COLOR="Navy"]Next[/COLOR] i
     [COLOR="Navy"]End[/COLOR] If
     Ray(c, ac + 1) = Join(Sp, ",")
      ac = ac + 2
     oMax = Application.Max(oMax, ac)
     [COLOR="Navy"]Next[/COLOR] p
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, oMax - 1)
    .Value = Ray
    .Columns.AutoFit
    .Borders.Weight = 2
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi Mick,

I need your help on the above coding.. Please fix this issue....

I am preparing this report everyday for the three previous working days. So on Monday, I would generate this report for Friday(Day 1), Thursday (Day2) and Wednesday (Day 3). This code considers Thursday as Day1 and Wednesday as Day2, whenever there is no data for a particular Dealer on Friday.

Also if have have data for a particula dealer only for Day1(Friday) and Day3(Wednesday), it considers Wednesday as Day2.

I am sorting the date column in descending order so as to make the recent day as Day1 and the next days as Day2 and Day3.

Regards,
Vinoth
 
Upvote 0
If I look down column "A" and use the data shown in any of the cells, that have any of the first 3 dates, Will that give you what you want ??????
 
Upvote 0
Thank you for you response...

In the below example, 08/07/2015 is Day1, 08/06/2015 is Day2, 08/05/2015 is Day3.

[TABLE="width: 302"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]Date[/TD]
[TD]Dealer[/TD]
[TD]Product[/TD]
[/TR]
[TR]
[TD="align: right"]8/7/2015[/TD]
[TD]Dealer A[/TD]
[TD]Mobile Phone[/TD]
[/TR]
[TR]
[TD="align: right"]8/7/2015[/TD]
[TD]Dealer A[/TD]
[TD]Laptop[/TD]
[/TR]
[TR]
[TD="align: right"]8/7/2015[/TD]
[TD]Dealer A[/TD]
[TD]Laptop[/TD]
[/TR]
[TR]
[TD="align: right"]8/7/2015[/TD]
[TD]Dealer A[/TD]
[TD]Laptop[/TD]
[/TR]
[TR]
[TD="align: right"]8/6/2015[/TD]
[TD]Dealer B[/TD]
[TD]Watch[/TD]
[/TR]
[TR]
[TD="align: right"]8/6/2015[/TD]
[TD]Dealer B[/TD]
[TD]Laptop[/TD]
[/TR]
[TR]
[TD="align: right"]8/6/2015[/TD]
[TD]Dealer B[/TD]
[TD]Watch[/TD]
[/TR]
[TR]
[TD="align: right"]8/5/2015[/TD]
[TD]Dealer A[/TD]
[TD]Mobile phone[/TD]
[/TR]
[TR]
[TD="align: right"]8/5/2015[/TD]
[TD]Dealer A[/TD]
[TD]Mobile Phone[/TD]
[/TR]
[TR]
[TD="align: right"]8/5/2015[/TD]
[TD]Dealer A[/TD]
[TD]Watch[/TD]
[/TR]
</tbody>[/TABLE]

I get this result

[TABLE="width: 803"]
<colgroup><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]Dealer[/TD]
[TD]Dealer Total [/TD]
[TD]Day1 Count[/TD]
[TD]Day1 Product Wise Count[/TD]
[TD]Day2 Count[/TD]
[TD]Day2 Reason Wise Count[/TD]
[/TR]
[TR]
[TD]Dealer A[/TD]
[TD]7[/TD]
[TD]4[/TD]
[TD]3-Laptop, 1-Mobile Phone[/TD]
[TD]3[/TD]
[TD]2-Mobile phone, 1-Watch[/TD]
[/TR]
[TR]
[TD]Dealer B[/TD]
[TD]3[/TD]
[TD]3[/TD]
[TD]2-Watch, 1-Laptop[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
</tbody>[/TABLE]

The expected result is

[TABLE="width: 1047"]
<colgroup><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]Dealer[/TD]
[TD]Dealer Total[/TD]
[TD]Day1 Count[/TD]
[TD]Day1 Reason Wise Count[/TD]
[TD]Day2 Count[/TD]
[TD]Day2 Reason Wise Count[/TD]
[TD]Day3 Count[/TD]
[TD] Day3 Reason Wise Count[/TD]
[/TR]
[TR]
[TD]Dealer A[/TD]
[TD]7[/TD]
[TD]4[/TD]
[TD]3-Laptop, 1-Mobile Phone[/TD]
[TD] [/TD]
[TD] [/TD]
[TD]3[/TD]
[TD]2-Mobile phone, 1-Watch[/TD]
[/TR]
[TR]
[TD]Dealer B[/TD]
[TD]3[/TD]
[TD] [/TD]
[TD] [/TD]
[TD]3[/TD]
[TD]2-Watch, 1-Laptop[/TD]
[TD] [/TD]
[TD]

[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Try this:-
The code assumes there are a maximum of 3 different dates in the data and the data is sorted by date (descending)
Code: 
[COLOR=Navy]Sub[/COLOR] MG11Aug03
'[COLOR=Green][B]Date positions[/B][/COLOR]
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, Dic [COLOR=Navy]As[/COLOR] Object, Q [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] K [COLOR=Navy]As[/COLOR] Variant, p [COLOR=Navy]As[/COLOR] Variant, g [COLOR=Navy]As[/COLOR] Variant, c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] ac [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] oMax [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Sp [COLOR=Navy]As[/COLOR] Variant, i [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] j [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] temp [COLOR=Navy]As[/COLOR] [COLOR=Navy]String,[/COLOR] Dic2 [COLOR=Navy]As[/COLOR] Object
    [COLOR=Navy]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
[COLOR=Navy]With[/COLOR] Sheets("Sheet4")
    [COLOR=Navy]Set[/COLOR] Rng = .Range(.Range("B2"), .Range("B" & Rows.Count).End(xlUp))
[COLOR=Navy]End[/COLOR] With
  ReDim Ray(1 To Rng.Count, 1 To Rng.Count)


[COLOR=Navy]Set[/COLOR] Dic2 = CreateObject("scripting.dictionary")
Dic2.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng.Offset(, -1): Dic2(Dn.Value) = Empty: [COLOR=Navy]Next[/COLOR]
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
        [COLOR=Navy]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
      [COLOR=Navy]End[/COLOR] If
      
       [COLOR=Navy]If[/COLOR] Not Dic(Dn.Value).Exists(Dn.Offset(, -1).Value) [COLOR=Navy]Then[/COLOR]
            [COLOR=Navy]Set[/COLOR] Dic(Dn.Value)(Dn.Offset(, -1).Value) = CreateObject("Scripting.Dictionary")
                        Dic(Dn.Value)(Dn.Offset(, -1).Value).CompareMode = 1
       [COLOR=Navy]End[/COLOR] If
            [COLOR=Navy]If[/COLOR] Not Dic(Dn.Value)(Dn.Offset(, -1).Value).Exists(Dn.Offset(, 1).Value) [COLOR=Navy]Then[/COLOR]
                  Dic(Dn.Value)(Dn.Offset(, -1).Value).Add (Dn.Offset(, 1).Value), 1
            [COLOR=Navy]Else[/COLOR]
                    Dic(Dn.Value)(Dn.Offset(, -1).Value).Item(Dn.Offset(, 1).Value) = _
                    Dic(Dn.Value)(Dn.Offset(, -1).Value).Item(Dn.Offset(, 1).Value) + 1
            [COLOR=Navy]End[/COLOR] If
                  
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]Dim[/COLOR] Col [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer,[/COLOR] H [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
c = 1
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] Dic.Keys
   ac = 3: c = c + 1: Col = 0
     [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] p [COLOR=Navy]In[/COLOR] Dic(K).Keys
        [COLOR=Navy]Select[/COLOR] [COLOR=Navy]Case[/COLOR] True
         [COLOR=Navy]Case[/COLOR] p = Dic2.Keys()(0): Col = 3: H = 1
         [COLOR=Navy]Case[/COLOR] p = Dic2.Keys()(1): Col = 5: H = 2
         [COLOR=Navy]Case[/COLOR] p = Dic2.Keys()(2): Col = 7: H = 3
         [COLOR=Navy]End[/COLOR] Select
            [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] g [COLOR=Navy]In[/COLOR] Dic(K)(p).Keys
                
                Ray(1, 1) = "Dealer": Ray(1, 2) = "Dealer Total"
                Ray(1, Col) = "Day" & H & " " & "Count"
                Ray(1, Col + 1) = "Day" & H & " " & "Prouduct Wise Count"
                Ray(c, 1) = K
                Ray(c, 2) = Application.CountIf(Rng, K)
                Ray(c, Col) = Ray(c, Col) + Dic(K)(p)(g)
                Ray(c, Col + 1) = Ray(c, Col + 1) & "," & Dic(K)(p)(g) & "-" & g
                [COLOR=Navy]If[/COLOR] Left(Ray(c, Col + 1), 1) = "," [COLOR=Navy]Then[/COLOR] Ray(c, Col + 1) = Mid((Dic(K)(p)(g) & "-" & g), 1)
            [COLOR=Navy]Next[/COLOR] g
      
      Sp = Split(Ray(c, Col + 1), ",")
      [COLOR=Navy]If[/COLOR] UBound(Sp) > 0 [COLOR=Navy]Then[/COLOR]
        [COLOR=Navy]For[/COLOR] i = 0 To UBound(Sp) - 1
            [COLOR=Navy]For[/COLOR] j = i To UBound(Sp)
                [COLOR=Navy]If[/COLOR] Split(Sp(j), "-")(0) > Split(Sp(i), "-")(0) [COLOR=Navy]Then[/COLOR]
                    temp = Sp(i)
                    Sp(i) = Sp(j)
                    Sp(j) = temp
                [COLOR=Navy]End[/COLOR] If
            [COLOR=Navy]Next[/COLOR] j
        [COLOR=Navy]Next[/COLOR] i
     [COLOR=Navy]End[/COLOR] If
     Ray(c, Col + 1) = Join(Sp, ",")
     oMax = Application.Max(oMax, Col)
     [COLOR=Navy]Next[/COLOR] p
[COLOR=Navy]Next[/COLOR] K
[COLOR=Navy]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, oMax + 2)
    .Parent.Range("A1").CurrentRegion.Clear
    .Value = Ray
    .Columns.AutoFit
    .Borders.Weight = 2
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
Unique dealers count who has billed combinations of each products
Replies
1
Views
297
etaf
etaf
H
  • Question Question
How to count Unique Client ID by month and year
Replies
5
Views
435
Fluff
Fluff
E
  • Solved
Add together figures for Year-To-Date (with criteria)
Replies
3
Views
251
Tetra201
Tetra201
M
  • Solved
VBA Copy & Paste Values onto itself based on Criteria
Replies
4
Views
1K
mst3kr
M
Z
  • Question Question
Count Distinct Values in Un-Filtered Table across Multiple Columns with 1 Criteria
Replies
0
Views
448
zero269
Z

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