Sequencer with Data Range

[JonRowland]

I'm going to try my best at explaining this as not coming acrosss well in my head.

What I is to conduct a Count of values within Col Z which to include first & last Date (Col A) they appear and last. However the values in Col Z may change at some point but may revert back to the original value at some point. When they revert back I won't the count to restart for this second period.

I want to do this within my VBA project

So Data something like

Col A	Col Z
01/01/2020	abcd
02/01/2020	abcd
03/01/2020	fghy
04/01/2020	fghy
05/01/2020	fghy
06/01/2020	abcd
07/01/2020	abcd
08/01/2020	fghy

Result I would like on a new WkSht

abcd	2	01/01/2020	02/01/2020
fghy	3	03/01/2020	05/01/2020
abcd	2	06/01/2020	07/01/2020
fghy	1	08/01/2020	08/01/2020

 

[BSALV]

with a normal pivottable or with a unique-function and an auxiliary column

Map1
	A																									Z	AA	AB	AC	AD	AE	AF	AG	AH
1	Col A																									Col Z	counter			Col Z	counter	#	min	max
2	1/01/2020																									abcd	1			abcd	1	2	1/01/2020	2/01/2020
3	2/01/2020																									abcd	1			fghy	2	3	3/01/2020	5/01/2020
4	3/01/2020																									fghy	2			abcd	3	2	6/01/2020	7/01/2020
5	4/01/2020																									fghy	2			fghy	4	1	8/01/2020	8/01/2020
6	5/01/2020																									fghy	2					-	-	-
7	6/01/2020																									abcd	3					-	-	-
8	7/01/2020																									abcd	3					-	-	-
9	8/01/2020																									fghy	4					-	-	-
10																																-	-	-
11																																-	-	-
Blad6

Cell Formulas
Range	Formula
AD1:AE5	AD1	=UNIQUE(Tabel1[[#All],[Col Z]:[counter]])
AF2:AF11	AF2	=IF(AE2>0,COUNTIF(Tabel1[counter],AE2),"-")
AG2:AG11	AG2	=IF(AE2>0,MINIFS(Tabel1[Col A],Tabel1[counter],AE2),"-")
AH2:AH11	AH2	=IF(AE2>0,MAXIFS(Tabel1[Col A],Tabel1[counter],AE2),"-")
AA2:AA9	AA2	=SUM(OFFSET([@counter],-1,,,),([@[Col Z]]<>OFFSET([@[Col Z]],-1,,,)))
Dynamic array formulas.

 

[JonRowland]

Hi BSALV,

Apologies....I'm not sure what I should entering. I keep getting errors. Although I wold have preferred a VBA solution to include within my project. But will give a go if I can work out what goes where.

 

[BSALV]

Sub Make_Summary()
     Dim Result()
     With Sheets("Blad3")                                       'your sheet
          Set c = .Range("A1").CurrentRegion                    'currentregion around A1
          a = c.Value2                                          'array A-column
          Z = c.Offset(, 25).Value                              'array Z-column

          ReDim Result(1 To UBound(a), 1 To 4)                  'prepare result-array (oversized)
          For i = 2 To UBound(a)                                'loop through the data
               If i = 2 Or Z(i, 1) <> Z(i - 1, 1) Then          '1st data row or changed Z
                    ptr = ptr + 1                               'increment pointer
                    Result(ptr, 1) = Z(i, 1)                    'new ID
                    Result(ptr, 3) = a(i, 1)                    'new startdate
               End If
               Result(ptr, 2) = Result(ptr, 2) + 1              'increment number
               Result(ptr, 4) = a(i, 1)                         'last date
          Next

          .Range("D1").Resize(ptr, 4).Value = Result            'write result to sheet
     End With
End Sub

 

[JonRowland]

Hi BSALV,

Thank you, this code is perfect and does what I was hoping to do.

Sub Make_Summary()
     Dim Result()
     With Sheets("Blad3")                                       'your sheet
          Set c = .Range("A1").CurrentRegion                    'currentregion around A1
          a = c.Value2                                          'array A-column
          Z = c.Offset(, 25).Value                              'array Z-column

          ReDim Result(1 To UBound(a), 1 To 4)                  'prepare result-array (oversized)
          For i = 2 To UBound(a)                                'loop through the data
               If i = 2 Or Z(i, 1) <> Z(i - 1, 1) Then          '1st data row or changed Z
                    ptr = ptr + 1                               'increment pointer
                    Result(ptr, 1) = Z(i, 1)                    'new ID
                    Result(ptr, 3) = a(i, 1)                    'new startdate
               End If
               Result(ptr, 2) = Result(ptr, 2) + 1              'increment number
               Result(ptr, 4) = a(i, 1)                         'last date
          Next

          .Range("D1").Resize(ptr, 4).Value = Result            'write result to sheet
     End With
End Sub