Update macro help. Delete rows that have no green text

[richiwatts]

Hi,

Can someone help me update 2 parts of this macro.

1. Get all important messages.
I need this part changed so that it deletes any row that doesn't have green font

' Save result to text file.
I need this part changed so that the name of the txt file is the same as the Excel file

Sub ImportantMessages()

    Dim ToClose As Boolean
    Dim i As Long, j As Long, iCount As Long
    Dim fso As FileSystemObject, txtFile As TextStream
    
    Application.ScreenUpdating = False
    
    ' 1. Get all important messages.
    For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        If Not Cells(i - 1, "A") Like "Message text*" Then
            Cells(i, 1).EntireRow.Delete
        End If
    Next
    
    ' 2. Get rid of columns B and D.
    Columns("B:B").Delete
    Columns("D:D").Delete
    
    ' 3. Get rid of black text and surround green text with brackets.
    For i = 2 To Range("A2").End(xlDown).Row
        With Cells(i, 2)
            ' Get rid of black text.
            For j = 1 To .Characters.Count
                If .Characters(j, 1).Font.ColorIndex = 1 Then
                    .Characters(j).Delete
                    Exit For
                End If
            Next
        End With
        Call SurroundWithBrackets(Cells(i, 1))
        Call SurroundWithBrackets(Cells(i, 2))
    Next

    ' Remove unused cells.
    Range(Range("A2").End(xlDown).Offset(1, 0), Cells(Rows.Count, 1)).EntireRow.Delete
    ActiveSheet.UsedRange

    ' Save result to text file.
    Set fso = New FileSystemObject
    Set txtFile = fso.CreateTextFile(Filename:=ThisWorkbook.Path & "\FileName.txt", Overwrite:=True, Unicode:=True)
    For i = 2 To Range("A2").End(xlDown).Row
        txtFile.WriteLine Cells(i, 1) & vbTab & Cells(i, 2)
    Next
    txtFile.Close

    Application.ScreenUpdating = True
    
    MsgBox "Text file has been successfully created!", vbInformation, "Info"

End Sub