Разбить строку на слова по нажатию первой кнопки, отсортировать список слов по нажатию второй

Dim StrStroka As String
Dim Stroka As String
StrStroka = Cells(1, 1)
For i = 1 To Len(StrStroka)
Select Case Mid(StrStroka, i, 1)
Case " ", ",", ".", "!", ":", ";", "/"
Stroka = Stroka & "*"
Case Else
Stroka = Stroka & Mid(StrStroka, i, 1)
End Select
Next i

do while instr(1,Stroka,"**")>0
Stroka=replace(Stroka,"**","*")
loop

dim a() as String
a()=Split(Stroka,"*")

dim dfg as Long
dfg=Ubound(a)

for i=2 to dfg+2
Cells(i,1)=a(i-2)
Cells(i,2)=a(i-2) 
next i

Range("B2:B" & dfg + 2).Select
Range("B" & dfg + 2).Activate
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Add Key:=Range("B2:B" & dfg + 2), _
    SortOn:=xlSortOnValues, Order:=1, DataOption:=0
    With ActiveWorkbook.Worksheets("Лист1").Sort
        .SetRange Range("B2:B" & dfg + 2)
        .Header = 0
        .MatchCase = False
        .Orientation = 1
        .SortMethod = 1
        .Apply
End With

wer = 0
For i = 0 To dfg
If wer < Len(a(i)) Then wer = Len(a(i))
Next i

y = 2
For i = 1 To wer
For k = 0 To dfg
If Len(a(k)) = i Then
Cells(y, 3) = a(k)
y = y + 1
End If
Next k

Sub Кнопка()
    Dim z As String
    Dim j As Integer
    Dim h As String
    Dim e As String
    Dim n
    n = 1
    z = Cells(1, 1).Value
    For j = 1 To Len(z)
    h = Asc(Mid(z, j, 1))
            If (h > 47 And h < 58) Or (h > 64 And h < 91) Or (h > 96 And h < 123) Or (h > 191 And h < 256) Then
            e = e & Mid(z, j, 1)
            Else
                    If Len(e) > 0 Then
                    n = n + 1
                    Cells(n, 1).Value = e
                    e = ""
                    End If
            End If
    Next j
       If Len(e) > 0 Then n = n + 1: Cells(n, 1).Value = e
End Sub

   For i = LBound(a) To UBound(a) - 1
    For j = i + 1 To UBound(a)
        If a(j) < a(i) Then
            buffer = a(j)
            a(i) = a(j)
            a(i) = buffer
        End If
         Next
    Next

Option Explicit
Const Ex = "Разбить строку, введённую в первую ячейку первого столбца активного листа, на слова, и вывести их в ячейки первого столбца, начиная со второй. Словом считается любая последовательность букв и цифр. Слова разделяются знаками препинания и/или пробелами. Идущие подряд разделители считаются одним. Полученный список слов отсортировать по возрастанию во втором столбце, начиная со второй строки. Для процедуры разбиения использовать одну кнопку, для процедуры сортировки – вторую"
Dim f&, s$, j$(), v
Sub Macro()
    Dim f&
    [a1] = Ex
    For Each v In ActiveSheet.Buttons: v.Delete: Next
    For f = 1 To 2
        With ActiveSheet.Buttons.Add(100, 30 * f, 60, 20)
            .OnAction = "Макрос" & f
            .Caption = Choose(f, "Разбить", "Сортировать")
        End With
    Next
End Sub
Sub Макрос1()
    j = Split([a1])
    look
End Sub
Sub Макрос2()
    If Join(j) = "" Then j = Split([a1])
    qSortStr j, 0, UBound(j)
    look
End Sub
Public Sub qSortStr(List() As String, ByVal min As Long, ByVal max As Long)
    Dim i&, l&: Static s1$, s2$
    i = min: l = max: s1 = List((i + l) \ 2)
    Do Until i > l: While List(i) < s1: i = i + 1: Wend: While List(l) > s1: l = l - 1: Wend
        If (i <= l) Then s2 = List(i): List(i) = List(l): List(l) = s2: i = i + 1: l = l - 1
    Loop
    If min < l Then qSortStr List, min, l
    If i < max Then qSortStr List, i, max
End Sub
Private Sub look(): For f = 0 To UBound(j): Cells(f + 2, 1) = j(f): Next: End Sub