Замена символов через раз - VB

Формулировка задачи:

итак, есть код найденный тут на форуме

Sub mac1()
Dim x
With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.HomeKey Unit:=wdStory
For Each x In Split(UDAL)
    Selection.Find.Execute x, Replace:=wdReplaceAll
Next
Selection.Find.Execute "1", ReplaceWith:="2", Replace:=wdReplaceAll
End Sub

оно заменяет (в данном случае) цифру 1 на 2. Но как сделать так чтобы заменяло не каждую единицу, а например через раз? Я так понимаю нужно подшаманить wdReplaceAll, но неуверен что прав в этом. какова цель: чтобы 111111..... было 2121212.... возможно ли это? забыл указать - кодес этот под макрос для ворда

Решение задачи: «Замена символов через раз»

textual
                            Листинг программы 
                        

                            Sub OddTextFilter()
Const s = "1" 'заменяемый символ (в нечётных позициях)
Const z = "2" 'заменяющий символ
Dim even As Boolean 'счётчик (датчик) чётности найденного s
 
With Selection
    .HomeKey wdStory 'перевод курсора в начало документа Word
    .Find.Text = s  'настройка диалога поиска/замены (который по CTRL h)
 
    
    Do While .Find.Execute(Replace:=wdReplaceNone) 'пока находим этот символ
        If Not even Then    'если он нечётный - заменяем на z
            .TypeText z     'впечатали z вместо найденного s
            .Collapse Direction:=wdCollapseEnd 'сброс выделения после очередной замены
        End If
        
        even = Not even 'расчёт на "первый-второй"
    Loop
    
End With
End Sub
                        