VBA Sequence ChatGPT Code

This VBA code is used to Sequence my personal ChatGPT Word document.

 ''' Date 2024 July30

 Sub ChatGPT_Sequence()
    ClearAllColorBg1
    BoldTextBetweenUserAndChatGPT2
    ReplaceUser3
    ReplaceGPTbyAnswer4
    DoubleParaToSingle5
    BoldTextBeforeLastDoubleStars
    BoldAndColorLinesStartingWithTripleHash
    MsgBox "Done"
End Sub 

 Sub ClearAllColorBg1()
    Selection.WholeStory
    Selection.Shading.Texture = wdTextureNone
    Selection.Shading.ForegroundPatternColor = wdColorAutomatic
    Selection.Shading.BackgroundPatternColor = wdColorAutomatic
End Sub 

 Sub BoldTextBetweenUserAndChatGPT2()
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Bold = True

    With Selection.Find
        .Text = "user^13(*)ChatGPT^13"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWildcards = True
    End With
    
    With Selection.Find.Replacement.Font
        .Size = 10
        .Bold = True
        .Color = wdColorBlue
        .Name = "Georgia"
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub 

 Sub ReplaceUser3()
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    
    With Selection.Find
        .Text = "user"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub 

 Sub ReplaceGPTbyAnswer4()
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = 10
        .Bold = False
        .Italic = False
        .Color = wdColorBlack
        .Name = "Courier New"
    End With
    With Selection.Find
        .Text = "ChatGPT^p"
        .Replacement.Text = "Answer: "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub 

 Sub DoubleParaToSingle5()
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p^p"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub 

 Sub BoldBeforeStarsColon6()
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Bold = True
    With Selection.Find
        .Text = "^13[!^13]@\*\*:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub 

 Sub BoldBeforeColonStars6B()
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Bold = True
    With Selection.Find
        .Text = "^13[!^13]@:\*\*"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub 

 Sub BoldBetweenStars7()
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Bold = True
    With Selection.Find
        .Text = "\*\*[!^13]@\*\*"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub 

 Sub TripleHash8()

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = 10
        .Bold = False
        .Italic = False
        .Color = wdColorBrown
        .Name = "Courier New"
    End With
    
    With Selection.Find
        .Text = "^13###*^13"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub 

 Sub BoldTextBeforeLastDoubleStars()
    Dim doc As Document
    Dim para As Paragraph
    Dim pos As Integer
    Dim lineText As String
    Dim rng As Range
    Dim lastPos As Integer
    
    ' Set the document
    Set doc = ActiveDocument
    
    ' Loop through each paragraph in the document
    For Each para In doc.Paragraphs
        lineText = para.Range.Text
        lastPos = InStrRev(lineText, "**")
        
        ' If '**' is found, bold the preceding text
        If lastPos > 1 Then
            Set rng = para.Range.Duplicate
            rng.End = rng.Start + lastPos - 1
            rng.Font.Bold = True
        End If
    Next para
End Sub 

 Sub BoldAndColorLinesStartingWithTripleHash()
    Dim doc As Document
    Dim para As Paragraph
    Dim lineText As String
    Dim rng As Range
    Dim pos As Integer
    
    ' Set the document
    Set doc = ActiveDocument
    
    ' Loop through each paragraph in the document
    For Each para In doc.Paragraphs
        lineText = para.Range.Text
        pos = InStr(lineText, "###")
        
        ' If the paragraph starts with '###', format the entire paragraph
        If pos = 1 Then
            Set rng = para.Range
            rng.Font.Bold = True
            rng.Font.Color = wdColorBrown
            rng.Font.Size = 11
        End If
    Next para
End Sub