search with a twist?

[mikewi]

I have just been given the very exciting job of comparing Quality Assurance Manuals to codes and standards. My process is first I put the QA manual that I'm reviewing into a 4 column table in word because the code below is great for searching words in any column (Thanks Greg). Secondly I have to verify the inclusion of the applicable code clauses. I generally pick a key word from the clause and run a search but since the manuals are anywhere from 50 to 200 pages this usually gives way too many returns. I'm wondering if there is a way to enter a sentence or clause I'm looking for into the "input box" and have the macro search for any 3 or 4 consecutive words from that sentence. Is this possible or am I dreaming?

Sub FilterTableContent()
     'A basic Word macro coded by Greg Maxey
    Dim oDoc As Document
    Dim oTbl As Table
    Dim oCell As Cell
    Dim strText As String, strRef As String
    Dim lngCol As Long
    Dim oRng As Range
    
    ActiveDocument.Tables(1).Range.Copy
    Set oDoc = Documents.Add
    oDoc.Range.Paste
    Set oTbl = oDoc.Tables(1)
    strText = InputBox("Search text?")
    lngCol = CLng(InputBox("Enter column to search", "Must be 1 - 4"))
    For Each oCell In oTbl.Range.Cells
        If oCell.RowIndex > 1 And oCell.ColumnIndex = lngCol Then
            On Error Resume Next
             'Assumes that reference cell is column 1
            If Left(oTbl.Cell(oCell.RowIndex, 1).Range.Text, Len(oTbl.Cell(oCell.RowIndex, 1).Range.Text) - 2) <> vbNullString Then
                strRef = Left(oTbl.Cell(oCell.RowIndex, 1).Range.Text, Len(oTbl.Cell(oCell.RowIndex, 1).Range.Text) - 2)
            End If
            If Left(oTbl.Cell(oCell.RowIndex, 1).Range.Text, Len(oTbl.Cell(oCell.RowIndex, 1).Range.Text) - 2) = vbNullString Then
                oTbl.Cell(oCell.RowIndex, 1).Range.Text = strRef
            End If
            On Error GoTo 0
            If Not InStr(UCase(oCell.Range.Text), UCase(strText)) > 0 Then
                 'If the base string isn't found then kill the row.
                oCell.Range.Select
                Selection.Rows.Delete
            Else
                 'The base string is found so look for the specific string.
                Set oRng = oCell.Range
                'oRng.End = oRng.End - 1
                With oRng.Find
                    .Text = strText
                    .MatchWholeWord = True
                    If Not .Execute Then
                        oCell.Range.Select
                        Selection.Rows.Delete
                    End If
                End With
            End If
        End If
    Next
lbl_Exit:
    Set oDoc = Nothing: Set oTbl = Nothing: Set oCell = Nothing
    Exit Sub
End Sub

[gmaxey]

Can you provided an example of what you have, what you want to enter as the search text and finally what the outcome should be. Keep it short and simple if possible.

[mikewi]

I have attached two documents:
1. code to compare to manual.
2. Manual to compare to code.

If you look at the code doc it has each clause in a cell. I would like to be able to copy the clause and paste it into the input box and have it search the manual doc for any 3 consecutive words. I'm wondering if it can ignore plural words and recognize the root word ( Organizes - organize). I have highlighted the three words in the code doc and entered the corresponding clause # from where it was found in the manual in column 3 for reference (this is actually my task). Really I just need the search to highlight the row and show me where it is so I can enter the clause # in the code reference doc column 3. Unless it can do that too. sometimes the same reference may be found in more than one section.

Thanks for looking at this guys I truly appreciate it.

[mikewi]

Is it possible that it could ignore punctuation marks as well?

[Kilroy]

Mikewi what an excellent idea. I'm in Quality Assurance too. This would be such an amazing tool. Would save so much time. I hope someone can figure this one out.

[mikewi]

To all the experts here. I am will to donate for a resolution to this. I don't expect anyone to work for free.

[gmaxey]

Your code for comparison to manual.docx + Your manual for comparison to code.docx = Gobbledygook

There is no "code" in either and offers no insight into what you want to do. Based on your separate description, I doubt it is possible. However, if you will provide what I asked for 1) A document as is before processing, 2) the phrase you want to enter the macro input box and 3) as document as it should appear after processing, I will give it a try.

[mikewi]

Sorry for not being very clear I appreciate you seeing if this is possible. The "code for comparison to manual" doc is my checklist that has clauses from NCA 4134 from the ASME boiler code and NQA-1 this is #2) from your list. The only relevance it has as far as the search goes is that it is where I manually copy the clause from that I want to search. The "Manual for comparison" doc (#1 from you list) is what I need to search. When the "Manual" doc is open I would like to run a macro similar to the code above in that it asks me what I want to search (this is when I would paste in the clause from the ASME code) and then it would search the "Manual" doc for any 3 consecutive words (ignoring punctuation marks) and highlight them or if possible just give me the value that's in column 1 of that row. It may bring back more than one result. For example: If I copied the words from clause 303 from the "Code for comparison” and pasted it in the search box it would either highlight the text in the "Manual" doc which it would find in 4.2.3 or ideally a window would pop up giving the value from column 1 where the search would find in row 4.2.3. or if it found it in more than one row it would give 4.2.3, (other rows it was found in). I would then take these numbers and manually enter them into my checklist "code for comparison" in column 3.

[mikewi]

So really I shouldn't have even mentioned the first document. When I reread my original post it isn't even clear to me. What I'm looking to do is search a 4 column table. Like the above code I would like a pop up search box that I can enter a sentence or multiple sentences where it will look at any 3 words in a row and ignore punctuation marks and then the second window that will ask which column to search the same as in the code above. So if I entered the following sentence:

"Prospective Lead Auditors, shall participate, in a minimum. of five quality assurance audits."

It would search for:

1. Prospective Lead Auditors
2. Lead Auditors shall
3. Auditors shall participate
4. shall participate in
5. participate in a

and so on until all 3 consecutive word searches are complete. The result ideally would be a pop up window with the return value from cell 1 of the row/rows the 3 word strings were found in.

Thanks again for looking at this problem and considering to share a resolution.

Mike W

[gmaxey]

You are asking for a complicated process. I'm not going to hand something to you on a silver platter. The idea here is that we help you learn to write your own code.
If you want to hire me to do this for you or donate then please visit my website and send feedback.

As for breaking down your string into chunks of three successive words:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim strIn As String, strRefined As String, strFind
Dim lngIndex As Long, lngCounter As Long
Dim arrWords() As String, arrFind() As String
  strIn = "Prospective Lead Auditors, shall participate, in a minimum. of five quality assurance audits"
  For lngIndex = 1 To Len(strIn)
    If Mid(strIn, lngIndex, 1) Like "[A-Za-z ]" Then
      strRefined = strRefined & Mid(strIn, lngIndex, 1)
    End If
  Next
  arrWords = Split(strRefined)
  ReDim Preserve arrFind(0)
  lngCounter = 0
  For lngIndex = 0 To UBound(arrWords)
    If lngCounter > 2 Then lngCounter = 0
    If lngCounter = 0 Then
      strFind = arrWords(lngIndex)
    Else
      strFind = strFind & " " & arrWords(lngIndex)
    End If
    If lngCounter = 2 Then
      arrFind(UBound(arrFind)) = strFind
      ReDim Preserve arrFind(UBound(arrFind) + 1)
      lngIndex = lngIndex - 2
    End If
    lngCounter = lngCounter + 1
  Next
  If UBound(Split(arrFind(UBound(arrFind)), " ")) < 2 Then
    ReDim Preserve arrFind(UBound(arrFind) - 1)
  End If
  For lngIndex = 0 To UBound(arrFind)
    Debug.Print arrFind(lngIndex)
  Next
lbl_Exit:
  Exit Sub
End Sub

[mikewi]

Thanks Greg I appreciate the push to learn. I just tried getting on to your site but it's blocked by my company for some reason. I will try to get on your site tonight from home.

[gmaxey]

Ok, just let me know how/if you want to proceed.

[Kilroy]

Hey Mikewi did you ever finish this code? Would be very helpful.

[mikewi]

No Kilroy. I made arrangements to have it written but I couldn't hold up my end of the bargain (MY employer is too cheap). I'll let you know if anything changes.