Macro to trigger building block for specific text in ms word docs

I am looking for a macro which run and trigger the building block for a specific text in ms word docs.

i love this below code got from this forum. But my thing is how to find a particular text and trigger this macro automatically

For example: If my word docs having text "MyBB" then i need the building block named "MyBB" comes automatically once i run the code

i have stored many building blocks and activating it with F3 key on particular text in daily work

Need a help to modify the code which runs a mentioned above

Sub InsertMyBB()
'
' Assumes that the Building Block is of the type AutoText (wdTypeAutoText) in Category "General"
' See https://msdn.microsoft.com/en-us/library/bb243303(v=office.12).aspx
'
' This is based in part upon contributions from Greg Maxey and Jay Freedman - any errors remain mine
' Written by Charles Kenyon February 2016
'
Dim sBBName As String
Dim sTempName As String
Dim oBB As BuildingBlock
sBBName = "MyBB" 'use the name of your building block instead of "MyBB"
sTempName = ThisDocument.FullName ' puts name and full path of template in string variable
On Error Resume Next
Application.Templates.LoadBuildingBlocks  ' thank you Timothy Rylatt
Set oBB = Application.Templates(sTempName).BuildingBlockTypes(wdTypeAutoText) \_
.Categories("General").BuildingBlocks(sBBName)
If Err.Number = 0 Then
oBB.Insert Selection.Range, True
Else
MsgBox Prompt:="The Building Block '" & sBBName & "' cannot be found in " & \_
ThisDocument.Name & ".", Title:="Didn't Work!"
End If
On Error GoTo 0
lbl_Exit:
Exit Sub
End Sub

Sub INSERTTABLE()
Dim strSearch As String


    strSearch = "3000"
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .MatchCase = True
        .Format = True
        .Text = strSearch
        .Execute
    Do While Selection.Find.Found = True And icount < 1000
    icount = icount + 1
    Selection.HomeKey unit:=wdStory
       Selection.Find.Execute
    Selection.Range.InsertAutoText
     
     Loop
   
    strSearch = "5000"
      Selection.Find.ClearFormatting
    With Selection.Find
         .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .MatchCase = True
        .Format = True
        .Text = strSearch
        .Execute
    Do While Selection.Find.Found = True And icount < 1000
    icount = icount + 1
    Selection.HomeKey unit:=wdStory

    Selection.Find.Execute
    Selection.Range.InsertAutoText

    Loop
   
    End With
    End With
   End Sub

Solution

Given a document reference, and an array of Building Block names, this method should replace the name of each building block with its corresponding content, for all instances found in the document:

Sub CheckAllBB()
'
' Assumes that the Building Block is of the type AutoText (wdTypeAutoText) in Category "General"
' See https://msdn.microsoft.com/en-us/library/bb243303(v=office.12).aspx
'
' This is based in part upon contributions from Greg Maxey and Jay Freedman - any errors remain mine
' Written by Charles Kenyon February 2016
'
    Dim sBBName As Variant, sTempName As String
    Dim oBB As BuildingBlock, oBBT As BuildingBlockType, doc As Document
    
    sTempName = ThisDocument.FullName
    Application.Templates.LoadBuildingBlocks  ' thank you Timothy Rylatt
    Set oBBT = Application.Templates(sTempName).BuildingBlockTypes(wdTypeAutoText)
    
    Set doc = ActiveDocument 'the document with placeholders to be replaced
    
    'loop over building block names
    For Each sBBName In Array("MyBB1", "MyBB2", "MyBB3")
        Set oBB = Nothing    'reset to nothing
        On Error Resume Next
        'Try to get the building block
        Set oBB = oBBT.Categories("General").BuildingBlocks(sBBName)
        On Error GoTo 0
        
        If Not oBB Is Nothing Then 'got the building block?
            ReplaceAllBB doc, oBB  'perform the replacement(s)
        Else
            MsgBox "The Building Block '" & sBBName & "' cannot be found in " & _
                    ThisDocument.Name & ".", vbExclamation, "Building Block not found"
        End If
    Next sBBName
        
End Sub


Sub ReplaceAllBB(doc As Document, BB As BuildingBlock)
    Dim allBB As New Collection, rng As Range
    Set rng = doc.Range
    With rng.Find
        .Forward = True
        .Text = BB.Name
        .MatchWholeWord = True
        Do While .Execute
            allBB.Add rng.Duplicate
        Loop
    End With
    Debug.Print "Found " & allBB.Count; " instances of '" & BB.Name & "'"
    For Each rng In allBB
        BB.Insert rng, True
    Next rng
End Sub