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.