Macro Issue About Specific Text Conditions in Excel

[yanlok1345]

Hello everyone,

I am at present wrestling with a challenging situation while developing a macro in Word. The task involves catering to a few specific conditions based on the data in columns A and B of sheet 3 of a certain Excel document. I was hoping to receive some guidance from the community.

The situation is such that if a text found in column A is encased either between Chrw(8220) and Chrw(8221) or "《" and "》", the macro should not highlights or add comments to it.

However, if any text in column A does not fall between Chrw(8220) and Chrw(8221) or "《" and "》", the macro must highlight it and add comments.

Here lies the issue - the macro I developed does not seem to adhere to these conditions. Unfortunately, irrespective of whether the text is between Chrw(8220) and Chrw(8221) or "《" and "》" or otherwise, it adds highlights and comments.

Here's the code:

Code: Select all

Sub Test()

Dim StartTime As Double
Dim SecondsElapsed As Double

  StartTime = Timer
  
    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    Dim wdDoc As Document
    Dim rng As Range
    Dim i As Long

    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open("D:\list.xlsx")
    Set wdDoc = ActiveDocument

   ' Process Sheet3
Set xlSheet = xlBook.Sheets(3)

For i = 1 To xlSheet.UsedRange.Rows.Count
    Set rng = wdDoc.Content

    With rng.Find
        .Text = xlSheet.Cells(i, "A").Value
        .MatchWildcards = xlBook.Sheets(3).Cells(i, "D").Value = "T"

        While .Execute
            If Not (InStr(1, rng.Text, ChrW(8220)) = 1 And InStr(1, rng.Text, ChrW(8221)) = Len(rng.Text) Or InStr(1, rng.Text, "《") = 1 And InStr(1, rng.Text, "》") = Len(rng.Text)) Then
                rng.HighlightColorIndex = xlSheet.Cells(i, "B").Value

                'Add Comment if column E is not empty
                If xlSheet.Cells(i, "E").Value <> "" Then
                    rng.Comments.Add rng, xlSheet.Cells(i, "E").Value
                End If
            End If
        Wend
    End With
Next i

    xlBook.Close
    xlApp.Quit
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    
    'Determine how many seconds code took to run
  SecondsElapsed = Round(Timer - StartTime, 2)
  
  MsgBox Prompt:=SecondsElapsed, Title:="Finished"
    
End Sub

Here's the sample file for testing:

Sample.docx

List.xlsx

For example, the macro should find sheet 3's text without between Chrw(8220) and Chrw(8221) or "《" and "》" , then highlight it and add comments to it.

I've been straining to pinpoint the flaw in this piece of code but haven't made much progress. Therefore, I would greatly appreciate it if anyone versed in such procedures could offer some troubleshooting tips, point out any possible mistakes, or provide any workarounds that might help resolve this issue.

Your help would indeed be invaluable.
Thank you all very much in advance for your guidance and assistance!

[HansV]

The characters Chr(8220) etc. are not part of the text you search for, so conditions such as
InStr(1, rng.Text, ChrW(8220)) = 1
will NEVER be true. You have to look for the characters immediately before and after the text you search for.

Code: Select all

Sub Test()
    Dim StartTime As Double
    Dim SecondsElapsed As Double

    StartTime = Timer

    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    Dim wDoc As Document
    Dim rng As Range
    Dim i As Long
    Dim c1 As String
    Dim c2 As String

    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open("D:\list.xlsx")
    Set wDoc = ActiveDocument

    ' Process Sheet3
    Set xlSheet = xlBook.Sheets(3)

    For i = 1 To xlSheet.UsedRange.Rows.Count
        Set rng = wDoc.Content

        With rng.Find
            .Text = xlSheet.Cells(i, "A").Value
            .MatchWildcards = xlBook.Sheets(3).Cells(i, "D").Value = "T"

            While .Execute
                c1 = wDoc.Range(rng.Start - 1, rng.Start).Text
                c2 = wDoc.Range(rng.End, rng.End + 1).Text
                If Not (c1 = ChrW(8220) And c2 = ChrW(8221) Or c1 = "«" And c2 = "»") Then
                    rng.HighlightColorIndex = xlSheet.Cells(i, "B").Value

                    'Add Comment if column E is not empty
                    If xlSheet.Cells(i, "E").Value <> "" Then
                        rng.Comments.Add rng, xlSheet.Cells(i, "E").Value
                    End If
                End If
            Wend
        End With
    Next i

    xlBook.Close
    xlApp.Quit
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing

    'Determine how many seconds code took to run
    SecondsElapsed = Round(Timer - StartTime, 2)

    MsgBox Prompt:=SecondsElapsed, Title:="Finished"
End Sub

[yanlok1345]

The characters Chr(8220) etc. are not part of the text you search for, so conditions such as
InStr(1, rng.Text, ChrW(8220)) = 1
will NEVER be true. You have to look for the characters immediately before and after the text you search for.

Code: Select all

Sub Test()
    Dim StartTime As Double
    Dim SecondsElapsed As Double

    StartTime = Timer

    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    Dim wDoc As Document
    Dim rng As Range
    Dim i As Long
    Dim c1 As String
    Dim c2 As String

    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open("D:\list.xlsx")
    Set wDoc = ActiveDocument

    ' Process Sheet3
    Set xlSheet = xlBook.Sheets(3)

    For i = 1 To xlSheet.UsedRange.Rows.Count
        Set rng = wDoc.Content

        With rng.Find
            .Text = xlSheet.Cells(i, "A").Value
            .MatchWildcards = xlBook.Sheets(3).Cells(i, "D").Value = "T"

            While .Execute
                c1 = wDoc.Range(rng.Start - 1, rng.Start).Text
                c2 = wDoc.Range(rng.End, rng.End + 1).Text
                If Not (c1 = ChrW(8220) And c2 = ChrW(8221) Or c1 = "«" And c2 = "»") Then
                    rng.HighlightColorIndex = xlSheet.Cells(i, "B").Value

                    'Add Comment if column E is not empty
                    If xlSheet.Cells(i, "E").Value <> "" Then
                        rng.Comments.Add rng, xlSheet.Cells(i, "E").Value
                    End If
                End If
            Wend
        End With
    Next i

    xlBook.Close
    xlApp.Quit
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing

    'Determine how many seconds code took to run
    SecondsElapsed = Round(Timer - StartTime, 2)

    MsgBox Prompt:=SecondsElapsed, Title:="Finished"
End Sub

Brilliant! It works perfectly! I can't thank you enough for your invaluable help. I've been struggling with this for days, and you've saved the day. Your expertise is truly appreciated!