Вставить перед каждой серией массива элемент с нулевым значением

Option Explicit
 
Private Sub Command1_Click()
    Dim Arr&(): Arr&() = GenerateArraySeries()
    PrintArray Arr&()
    
    'создаем максимально необходимую буфер-зону и смещаем все эл-ты вправо
    Dim UB&: UB = UBound(Arr&())
    Dim diff&: diff = (UB + 1) \ 2
    Dim MaxLen&: MaxLen = UB + diff
    ReDim Preserve Arr&(MaxLen)
    Dim i&
    For i = UB To 0 Step -1
        Arr(i + diff) = Arr(i)
        'Arr(i) = 0
    Next
    'PrintArray Arr&()
    
    Dim flag As Boolean: flag = False
    Dim p&: p = 0
    For i = diff To MaxLen - 1
        If Arr(i) = Arr(i + 1) Then
            If Not flag Then
                Arr(p) = 0
                p = p + 1
                flag = True
            End If
        Else
            flag = False
        End If
        Arr(p) = Arr(i)
        p = p + 1
    Next
    
    Arr(p) = Arr(MaxLen)
    ReDim Preserve Arr&(p)
    PrintArray Arr&()
End Sub
 
 
 
Private Function GenerateArraySeries()
    Dim num&, i&, s&, n&
    Dim Arr&(): ReDim Arr&(19)
    
    Randomize
    
    For i = 1 To 10
        num = Int(Rnd * 10)
        'генерируем серии
        For s = 1 To Int(Rnd * 2) + 1
            Arr(n) = num
            n = n + 1
        Next s
    Next i
    
    ReDim Preserve Arr&(n - 1)
    GenerateArraySeries = Arr&()
End Function
 
Private Sub PrintArray(Arr&())
    Dim el
    For Each el In Arr&()
        Me.Print el; " ";
    Next
    Me.Print vbLf
End Sub