Header 2 text does not match the exact same text in excel : VBA - vba

Question

I am creating a project that lets the user create a task list within excel and then compares the user created tasks-text to the second header-text, (Header 2) within a pre-made word document. I am able to get the second header text and save it to an array, and then get the user task list and save that within an array. I then try and see if the task text that is within the Program (The second headers) are within the user task list using the function
If IsError(Application.Match(ProgArray(x), TaskArray, 0)) Then
'Find within word document and highlight red
End if
The problem I am getting is that this always returns with an error because for some reason, even though the built in watch screen debugger says otherwise, the text within the word document does not equal the exact same text within the excel sheet.
At first I used a comparing text software to determine that the header's text from word might have actually copied an extra line.
Picture of explanation:
But then I tried to trim, and check for whether or not the header text had vbNewLine
If Right$(StrFound, 2) = vbCrLf Or Right$(StrFound, 2) = vbNewLine Then
Also to no avail, as this if statement was never triggered.
My question is, is taking text from a word document also pulling some hidden value that I am just missing, and if so is there any way around this? Thank you and sorry for the wall of text.
Lastly here is my complete code: (Its not pretty as I am just going for functionality right now)
'Sub CheckHeader()
Dim blnFound As Boolean
Dim StrFound As String
Dim x As Integer, y As Integer, z As Integer
Dim TaskTotal As Integer
Dim ProgArray(149) As String
Dim TaskArray() As String
Dim NotInArray() As String
Dim NotInProg() As String
Dim appWd As Object
Dim TaskSheet As Worksheet
Set appWd = GetObject(, "Word.Application")
Set wdFind = appWd.Selection.Find
Set TaskSheet = Sheets("Task List")
'Get Task List from Excel
TaskTotal = TaskSheet.Cells(TaskSheet.Rows.Count, 1).End(xlUp).Row - 1
ReDim TaskArray(TaskTotal) As String
ReDim NotInProg(TaskTotal) As String
ReDim NotInArray(TaskTotal) As String
'Get User task list into an array to compare - 0 to 0 is for testing
For x = 0 To 0 'TaskTotal - 1
TaskArray(x) = TaskSheet.Cells(2 + x, 5).Value '+ " (" & TaskSheet.Cells(2 + x, 1).Value + " " _
& TaskSheet.Cells(2 + x, 3).Value + ": " & TaskSheet.Cells(2 + x, 4).Value + ")"
Next x
x = 0
y = 0
'Find all instances of Headings
With ActiveDocument.Range.Find
'.Text = "Test"
.Style = "Heading 2"
Do
blnFound = .Execute
If blnFound Then
'MsgBox .Parent.Text
StrFound = .Parent.Text
'StrFound = Right(StrFound, InStr(StrFound, ")") + 1)
StrFound = CStr(StrFound)
TaskSheet.Cells(2 + x, 120).Value = StrFound
'At first I thought it was also saving a new line but I couldn't get rid of it
If Right$(StrFound, 2) = vbCrLf Or Right$(StrFound, 2) = vbNewLine Then
z = 1
End If
ProgArray(x) = TaskSheet.Cells(2 + x, 120)
'StrFound
x = x + 1
Else
Exit Do
End If
Loop
End With
'Compare if List is in Program
For x = 0 To 149
If x < TaskTotal - 1 Then
If IsError(Application.Match(TaskArray(x), ProgArray, 0)) Then
NotInProg(y) = TaskArray(x)
y = y + 1
End If
End If
'If the header is not within the user created task list then run this case
If IsError(Application.Match(ProgArray(x), TaskArray, 0)) Then
'used for debugging, for some reason the header text is larger than the user text
MsgBox StrComp(ProgArray(x), TaskArray(x))
NotInArray(z) = ProgArray(x)
SearchName = NotInArray(z)
'Increase element
z = z + 1
'Check Program and highlight to show that what is in the program is not in the user task list
With wdFind
.Text = SearchName
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Execute
End With
If wdFind.Found Then
'MsgBox " Found it"
appWd.Selection.Range.HighlightColorIndex = wdRed
Else
MsgBox ProgArray(x) + " is not in TaskList"
End If
Else
'Otherwise it is in the program and if it was red, unhighlight the text
SearchName = TaskArray(x)
With wdFind
.Text = SearchName
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Execute
End With
If wdFind.Found Then
'MsgBox " Found it"
appWd.Selection.Range.HighlightColorIndex = wdNoHighlight
' For not in task Selection.Range.HighlightColorIndex = wdRed
' For not in prog Selection.Range.HighlightColorIndex = wdYellow
Else
MsgBox TaskArray(x) + " is not here"
End If
End If
'Lastly Check for Ordering
Next x
End Sub'

Answer 1

There are two problems within your code and solutions to them are as follows:
To cut new paragraph mark we need to cut it of in this way:
.Parent.SetRange .Parent.Start, .Parent.End - 1
Which you need to put just before:
StrFound = .Parent.Text
Additionally, add .Parent.MoveEnd right after x=x+1 inside your do...loop.