Sub Comma()

    Selection.find.ClearFormatting
    With Selection.find
        .Text = "[0-9]{3,}"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    With Selection
    Do While .find.Execute = True
    If IsNumeric(.Range.Text) = True Then
    Select Case .Range.Characters.Count
    Case 4
    If .Range.Text Like "20??" Then
    
    Else
    .Range.Characters(1).InsertAfter (",")
    .MoveRight wdCharacter, 1
    End If
    Case 5
    .Range.Characters(2).InsertAfter (",")
    .MoveRight wdCharacter, 1
    Case 6
    .Range.Characters(1).InsertAfter (",")
    .Range.Characters(4).InsertAfter (",")
    .MoveRight wdCharacter, 1
    Case 7
    .Range.Characters(2).InsertAfter (",")
    .Range.Characters(5).InsertAfter (",")
    .MoveRight wdCharacter, 1
    Case 8
    .Range.Characters(1).InsertAfter (",")
    .Range.Characters(4).InsertAfter (",")
    .Range.Characters(7).InsertAfter (",")
    .MoveRight wdCharacter, 1
   Case 9
    .Range.Characters(2).InsertAfter (",")
    .Range.Characters(5).InsertAfter (",")
    .Range.Characters(8).InsertAfter (",")
    .MoveRight wdCharacter, 1
   Case 10
    .Range.Characters(1).InsertAfter (",")
    .Range.Characters(4).InsertAfter (",")
    .Range.Characters(7).InsertAfter (",")
    .Range.Characters(10).InsertAfter (",")
    .MoveRight wdCharacter, 1
    
    End Select
    End If
    Loop
        End With

    
End Sub