How to determine groups of consecutive values?

Question

I have some data in column A like this

ColA
Z
A

Z
A

Z
A
A
B
B
B

Z
B
B

Z
C
C
C
D
D

I want to print in column B

• "0" if cell in A = "Z"

• empty when cell in A is empty

• When a group begins for example with letter A, then all next A's should be marked with 1.

• When a next group begins, i.e. with letter B, then mark all following B's with 2,

• When begins a new group i.e with letter C, mark with value 1 again and so on.

• the values in column A are not letters in alphabetical sequence. Is only an example. I only know the value of "Z", the groups could have any string

This is, alternate assigning values 1 and 2 for each new group. I hope make sense.

This is my current code

Sub t1()
Dim dict As Object

Set dict = CreateObject("Scripting.Dictionary")

For i = 1 To 24
    If Cells(i, "A") = "Z" Then
        Cells(i, "B") = "0"
    ElseIf Cells(i, "A") <> "Z" And Cells(i, "A") <> "" Then
        counter = counter + 1
        dict.Add Key:=Cells(i, "A"), Item:=1
        
        If Not dict.Exists(Cells(i, "A")) Then
            If counter Mod 2 = 1 Then
                Cells(i, "B") = "1"
            Else
                Cells(i, "B") = "2"
            End If
        End If
    End If
Next
End Sub

My curent output in column B and my expected output in Column Cells

ColA ColB    ColC
Z      0     0
A      1     1
           
Z      0     0
A      2     1
           
Z      0     0
A      1     1
A      2     1
B      1     2
B      2     2
B      1     2
           
Z      0     0
B      2     2
B      1     2
           
Z      0     0
C      2     1
C      1     1
C      2     1
D      1     2
D      2     2

Maybe someone could help me. Thanks

Answer 1

Hello, no. Imagine Z and empty values don't exist. Then we have this input A,A,A,B,C,C,C,C,D,D,A,E,E,E,B,A. I only want the alternation between 1 and 2 for each new group. Doesn't matter if A has appeared before, should be taken as new group. With this input the, output should be 1,1,1,2,1,1,1,1,2,2,1,2,2,2,1,2 – Ger Cas 9 hours ago

Try this crazy formula (I am sure this can be made simpler). Put this in cell B2 as shown in the screenshot below

=IF(ISBLANK(A2),"",IF(A2="Z",0,IF(A2=A1,B1,IF(OR(A1="Z",ISBLANK(A1)),IF(ISERROR(INDEX($A$1:$A1,AGGREGATE(14,6,ROW($1:1)/($A$1:$A1=A2),1))),IFERROR((A1+1),1),IF(OR(INDEX($A$1:$A1,AGGREGATE(14,6,ROW($1:1)/($A$1:$A1=A2),1)+1)="Z",INDEX($A$1:$A1,AGGREGATE(14,6,ROW($1:1)/($A$1:$A1=A2),1)+1)=""),INDEX(B:B,MATCH(A2,$A$1:$A1,0),1),1)),IF(B1=1,2,IF(B1=2,1,""))))))

Let's say you data looks like this

Explanation

Following a sequence of checks in the below order

1. ISBLANK(A2): Check if the cell is empty. If it is empty then keep output blank.
2. A2="Z": Check if the cell has "Z". Output 0.
3. A2<>A1: Check if the value changes in column A. If it doesn't then pick up value from top. If it changes then see next check
4. Then we use INDEX with AGGREGATE() to do a reverse match to find the occurence of the value and if a match is found then pull the respective value from Column B

Answer 2

Try this code

Sub Test()
    Dim r As Range, c As Range, s As String, n As Long, x As Long, y As Long
    With ThisWorkbook.Worksheets("Sheet1")
        .Columns(2).ClearContents
        For Each r In .Columns(1).SpecialCells(2).Areas
            n = 0: x = 0
            For Each c In r
                If c.Value = "Z" Then
                    c.Offset(, 1).Value = 0
                Else
                    If c.Value <> s And c.Address = r(2).Address Then y = 0
                    If c.Value <> c.Offset(-1).Value And c.Address = r(2).Address And s <> "" Then
                        If c.Value = s Then c.Offset(, 1).Value = y: GoTo Skipper
                    End If
                    If c.Value <> c.Offset(-1).Value Then
                        n = n + 1: c.Offset(, 1).Value = n + y
                    Else
                        c.Offset(, 1).Value = c.Offset(-1, 1).Value
                    End If
                End If
Skipper:
                x = x + 1
                If r.Cells.Count = x Then s = c.Value: y = c.Offset(, 1).Value
            Next c
        Next r
    End With
End Sub

Here's snapshot

Answer 3

Try,

Sub test()
    Dim vDB, vR()
    Dim Dict As Object
    Dim i As Long, r As Long
    Dim cnt As Integer
    
    vDB = Range("a1", Range("a" & Rows.Count).End(xlUp))
    Set Dict = CreateObject("Scripting.Dictionary")
    r = UBound(vDB, 1)
    
    ReDim vR(1 To r, 1 To 1)
    For i = 1 To r
        If vDB(i, 1) = "" Then
            cnt = 0
            Set Dict = CreateObject("Scripting.Dictionary") '
        Else
            If vDB(i, 1) Like "Z*" Then
                vR(i, 1) = 0
            Else
                If Dict.Exists(vDB(i, 1)) Then
                    vR(i, 1) = Dict(vDB(i, 1))
                Else
                    cnt = cnt + 1
                    Dict.Add vDB(i, 1), cnt
                    vR(i, 1) = Dict(vDB(i, 1))
                End If
            End If
        End If
    Next i
    Range("b1").Resize(r) = vR
End Sub

Result image