VBA Word: Applying Character Style to first two words of specific paragraph style

Question

I would like to apply a character style ("Bold Italics") to the first two words of all paragraphs set in the "3 Species" style in MS Word (and later, I'd also like another macro to do same for all the words after the second tab in a different style). I know how to do all this in InDesign, but I'd like it set up in the original Word documents before they get flowed into InDesign.

I'm new at this and can't figure out how to apply it to only the first two words. I did get it to apply the character style to the whole paragraph or to a specific word in that style. It seems like it ought to be simple, but I've only learned to use find and replace type functions so far, and I imagine I will have to use the Range functions, which I don't understand yet. Thanks for any help!

Sub Add_Character_Style()
'
' Add_Character_Style Macro
'
  Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Style = "3 Species"
        .Text = ""
        .Replacement.Text = ""
        .Replacement.Style = "Bold Italics"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
   End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Answer 1

For example:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<*>[,. ^s^t]@<*>"
    .Style = "3 Species"
    .Replacement.Text = ""
    .Format = True
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    .Style = "Bold Italics"
    .Start = .Paragraphs(1).Range.End
  Loop
End With
Application.ScreenUpdating = True
End Sub

Answer 2

Try this:

Sub Add_Character_Style()
    Dim p As Paragraph
    Dim doc As Document: Set doc = ActiveDocument
    For Each p In doc.Paragraphs
        p.Range.Select
        Selection.Collapse Direction:=wdCollapseStart
        Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
        With Selection
            If .Style = "3 Species" Then .Style = "Bold Italic"
        End With
    Next p
End Sub

EDIT: To avoid use of the Selection object (Timothy Rylatt)

Sub Add_Character_Style()
   Dim p As Paragraph
   Dim doc As Document: Set doc = ActiveDocument
   Dim rng As Range
   For Each p In doc.Paragraphs
      If p.Range.Style = "3 Species" Then
         Set rng = p.Range
         With rng
            .Collapse Direction:=wdCollapseStart
            .MoveEnd Unit:=wdWord, Count:=2
            .Style = "Bold Italics"
         End With
      End If
   Next p
End Sub

FURTHER EDIT per macropod:

Sub Add_Character_Style()
Application.ScreenUpdating = False
Dim Para As Paragraph, Rng As Range
For Each Para In ActiveDocument.Paragraphs
  With Para
    If .Style = "3 Species" Then
      If .Range.ComputeStatistics(wdStatisticWords) > 1 Then
        Set Rng = .Range.Words.First
        With Rng
          Do While .ComputeStatistics(wdStatisticWords) < 2
            .MoveEnd wdWord, 1
          Loop
          .Style = "Bold Italic"
        End With
      End If
    End If
  End With
Next
Application.ScreenUpdating = True
End Sub