none
VBA Loop based upon mulitple searches RRS feed

  • Question

  • I have an interesting dilemma.  I have a long report, sometimes over 100 pages, but can also be only 4 or 5 pages that has patient information and a patient record divider line made up of underscore a checkbox at the end with two vertical bars.  This is the only consistent piece in the report.  Records that are ANC, FECES FIT, ARTERIAL BLOOD, etc. can be skipped in the review.  So I wrote a macro to find each of this words in a regular for next loop and highlight them, but I want to replace the underscore box at the end of the patient record divider ie. "|____|" with "|SKIP|" to make it quick and easy to review the report and deal with only the necessary records.   So if I do a search on any of the above phrases, for example "ANC" and find an occurance, I can then do another search for "|____|" and it will obviously be the one that is just below the first search and I can replace it with "|SKIP|".  Then right arrow one character and search for the next occurrence of "ANC" and when found replace the underscore box again.  This two step search is my problem.  I wrote a macro that can do this using a "For Next" loop, but I never know how many of each type items, ie ANC, FIT, ARTERIAL, that I will get, and if the counter is set for say, 20 or 50, it loops through and begins replacing the "|____|" in the next record down, since the underscore in the current patient record got changed to "|SKIP|" on the first pass.  So I need to figure out how to do this search or loop until it finds the last search.  I tried using a "do while" loop and a statement like  Do While .Execute(Forward:=True) = True

    I can't seem to figure out the syntax to get this to work.  So, below is a sample report with names and information changed so you can see what I am working with.  Below that is the macro I created with the for next loop.

    ==== START SAMPLE DATA ====
    SPECIAL REPORT: SEARCHING FOR CRITICAL FLAGS  02/28/1997 08:41   Pg 1
    For date range: 02/27/2015  to 02/27/2015
    -------------------------------------------------------------------------------
    RUMDMAND,ROB       123-45-6789 HBPC         COAG 02/27/1997 11:47
     PLASMA
      INR         5.90 RATIO    H* Ref. Range: none-none     Critical: none-4.0
    COMMENT(S): ~For Test: PT-HS/INR
                CALLED AND CONFIRMED WITH READ-BACK 2-27-17
                RESULT(S) VERIFIED BY REPEAT ANALYSIS
    _______________________________________________________________________________________|____|
    BIGBUCK,DEER     1B8-C8-AB32 9C           MRSA. 02/24/1997 14:27
     NARES
      MRSA SCRE POSITIVE        H* Ref. Range: "NEGATIVE"-"" Critical: none-none
    COMMENT(S): E-MAIL TO ICP
                PATIENT PREVIOUSLY NARES MRSA POSITIVE
    _______________________________________________________________________________________|____|
    SAUCE, ALFREDO         987-65-4321 SUR ICU      RESP 02/27/1997 19:02
     ARTERIAL BLOOD
      pH-ABG      7.13          L* Ref. Range: 7.35-7.45     Critical: 7.25-7.55
    COMMENT(S): ~For Test: ARTERIAL BLOOD GASES
                ~aline draw, 16/450/60/+5
    _______________________________________________________________________________________|____|
    CAVERN, BEEF E         2A2-22-22B2 SUR ICU      CH 02/27/1997 19:14
     SERUM
      K            6.5 MMOL/L   H* Ref. Range: 3.5-5.0       Critical: 3.0-5.7
    COMMENT(S): CALC & CL RESULT(S) VERIFIED BY REPEAT ANALYSIS Sample Not Hemolyzed.
                CALLED AND CONFIRMED WITH READ-BACK
    _______________________________________________________________________________________|____|
    FETCHIT,TERRIER DOG      55A-5B-555C UNITB        ANC 02/27/1997 04:52
     BLOOD
      GLU-ANC       58 mg/dL    L* Ref. Range: 60-110        Critical: 50-399
    COMMENT(S): Provider Notified
    _______________________________________________________________________________________|____|
    FREETEST,RUNTOGETIT 2A1-5I-1O2R  UNITC      URINE 02/24/1997 11:38
     FECES
      FIT       POSITIVE        H* Ref. Range: "NEG"-""      Critical: none-none
    _______________________________________________________________________________________|____|
    ==== END SAMPLE DATA ====

    MY FOR NEXT LOOP MACRO

    For vOutLoop = 1 To 4
    Selection.HomeKey Unit:=wdStory
    'This section assigns the words to be marked for skipping")
        Selection.HomeKey Unit:=wdStory
    If vOutLoop = 1 Then
        vtext = "Arterial"
        ElseIf vOutLoop = 2 Then
        vtext = "ANC"
        ElseIf vOutLoop = 3 Then
        vtext = "FIT"
        ElseIf vOutLoop = 4 Then
        vtext = "PREVIOUS"
        Else
        vtext = "ANC"
       End If
    '
    'Inner loop to check every line
    '
    For myloop = 1 To 100
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = vtext
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        With Selection.Find
            .Text = "|"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        Selection.TypeText Text:="SKIP|"
        Selection.MoveRight Unit:=wdCharacter, Count:=1
      Next myloop
    Next vOutLoop

    END OF MACRO CODE.

    Any help would be GREATLY appreciated!


    • Edited by kengooch Thursday, March 2, 2017 2:56 PM
    Wednesday, March 1, 2017 1:37 PM

Answers

  • Sub test()
        Dim vtext As Variant
        For Each vtext In Array("Arterial", "ANC", "FIT", "PREVIOUS")
            Selection.HomeKey Unit:=wdStory
            
            '
            'Inner loop to check every line
            '
            While True
                Selection.Find.ClearFormatting
                Selection.Find.Replacement.ClearFormatting
                With Selection.Find
                    .Text = vtext
                    .Replacement.Text = ""
                    .Forward = True
                    .Wrap = wdFindContinue
                    .Format = False
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                End With
                Selection.Find.Execute
                With Selection.Find
                    .Text = "|"
                    .Replacement.Text = ""
                    .Forward = True
                    .Wrap = wdFindContinue
                    .Format = False
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                End With
                Selection.Find.Execute
                Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
                If Selection.Text <> "|SKIP|" Then
                    Selection.Text = "|SKIP|"
                Else
                    GoTo DoNextWord
                End If
            Wend
    DoNextWord:
        Next vtext
    End Sub
    • Marked as answer by kengooch Thursday, March 2, 2017 1:19 PM
    Wednesday, March 1, 2017 6:10 PM

All replies

  • Sub test()
        Dim vtext As Variant
        For Each vtext In Array("Arterial", "ANC", "FIT", "PREVIOUS")
            Selection.HomeKey Unit:=wdStory
            
            '
            'Inner loop to check every line
            '
            While True
                Selection.Find.ClearFormatting
                Selection.Find.Replacement.ClearFormatting
                With Selection.Find
                    .Text = vtext
                    .Replacement.Text = ""
                    .Forward = True
                    .Wrap = wdFindContinue
                    .Format = False
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                End With
                Selection.Find.Execute
                With Selection.Find
                    .Text = "|"
                    .Replacement.Text = ""
                    .Forward = True
                    .Wrap = wdFindContinue
                    .Format = False
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                End With
                Selection.Find.Execute
                Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
                If Selection.Text <> "|SKIP|" Then
                    Selection.Text = "|SKIP|"
                Else
                    GoTo DoNextWord
                End If
            Wend
    DoNextWord:
        Next vtext
    End Sub
    • Marked as answer by kengooch Thursday, March 2, 2017 1:19 PM
    Wednesday, March 1, 2017 6:10 PM
  • Based on your sample, the following should work. Put all the words and phrases that you wish to find in the string at the start separated by the pipe character '|'

    This assumes that the found characters will be those on a line by themselves. If you want every instance of the words and phrases to be found, the result will be a mess and even harder to read.

    In such circumstances, post a screen shot of the sample text with the terms you want found highlighted.

    Sub HighlightValues()
    Const strFind As String = "ANC|FIT|ARTERIAL BLOOD|FECES"
    Dim vFind As Variant
    Dim oRng As Range
    Dim oRest As Range
    Dim i As Integer
        vFind = Split(strFind, "|")
        For i = LBound(vFind) To UBound(vFind)
            Set oRng = ActiveDocument.Range
            With oRng.Find
                Do While .Execute(FindText:=vFind(i))
                    If oRng.End = oRng.Paragraphs(1).Range.End - 1 Then
                        oRng.HighlightColorIndex = wdYellow
                        oRng.Collapse 0
                        Set oRest = ActiveDocument.Range
                        oRest.Start = oRng.Start
                        With oRest.Find
                            Do While .Execute(FindText:="|____|")
                                oRest.Text = "|SKIP|"
                                oRest.HighlightColorIndex = wdTurquoise
                                Exit Do
                            Loop
                        End With
                    End If
                Loop
            End With
        Next i
    End Sub


    Graham Mayor - Word MVP
    www.gmayor.com


    Thursday, March 2, 2017 5:08 AM
  • Wow This worked perfectly!!!

    thanks so much!!!  This will save me 20 to 30 minutes a day on just this one report!

    Ken

    Thursday, March 2, 2017 1:20 PM