macro - comand group not working

Hi.  I have this macro called 'Update' and it will run through and renumber pages.  However, If I click Undo in the tool bar it does not roll back to the point before the pages were all renumbered.  Am I missing something?

code:

Sub update()
Dim pageThis As Page
Dim s As Shape
ActiveDocument.BeginCommandGroup
Optimization = True
    For Each pageThis In ActiveDocument.Pages
        Set sPageNumThis = pageThis.Shapes.FindShape("pagetotal")
        If Not sPageNumThis Is Nothing Then
            sPageNumThis.Text.Story = CStr(ActiveDocument.Pages.Count)
        End If
    Next pageThis
Optimization = False
ActiveDocument.EndCommandGroup
End Sub