Count Consecutive Dates

[DeaninGA]

So I have a list of products that may show up on a report for consecutive dates. I'd like to count the current consecutive Workdays (Monday -Friday) the product has been on the list and reset the counter once it disappears for 1 day. Thank you in advance. Dean

	A	B
1	Report Day	Product #
2	5/1/2019	115112
3	5/1/2019	110123
4	5/1/2019	995000
5	5/2/2019	115112
6	5/2/2019	99500
7	5/3/2019	115112
8	5/3/2019	110123
9	5/6/2019	995000
10	5/6/2019	110123
11	5/6/2019	995000
12	5/7/2019	995000
13	5/8/2019	115112
14	5/8/2019	110123
15	5/8/2019	995000
16	5/9/2019	115112
17	5/9/2019	110123
18	5/9/2019	995000
19	5/10/2019	115112

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

Sheet1​

 

[BlueAure]

Are you looking for a VBA solution or a formula? It wouldn't be hard for VBA.

 

[DeaninGA]

Sorry VBA Preferably

 

[MickG]

Assuming your data start "A2" then try this for results "Count", starting in column "C" against the first of each "Product #".

[COLOR="Navy"]Sub[/COLOR] MG22May12
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range("B2", Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Dn
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, P [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Range, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
   Ac = 1
    [COLOR="Navy"]Set[/COLOR] R = .Item(K)(1)
    R.Offset(, Ac) = 1
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] P [COLOR="Navy"]In[/COLOR] .Item(K)
            [COLOR="Navy"]If[/COLOR] P.Offset(, -1) = R.Offset(, -1) + 1 [COLOR="Navy"]Then[/COLOR]
                .Item(K)(1).Offset(, Ac) = .Item(K)(1).Offset(, Ac) + 1
                [COLOR="Navy"]Set[/COLOR] R = P
            [COLOR="Navy"]ElseIf[/COLOR] P.Offset(, -1) > R.Offset(, -1) + 1 [COLOR="Navy"]Then[/COLOR]
                 Ac = Ac + 1
                 .Item(K)(1).Offset(, Ac) = 1
                    [COLOR="Navy"]Set[/COLOR] R = P
            [COLOR="Navy"]End[/COLOR] If
       [COLOR="Navy"]Next[/COLOR] P
 [COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[DeaninGA]

@mick Thank you will try this once I get back in the office next week