Match a String containing Wildcards and Pasting Paragraph to Excel

[Aerogal]

Hello - I'd greatly appreciate anyone's help. My VBA knowledge is iffy at best. I'm using prior code with some modifications to accomplish my current task at hand. I have a document with special paragraphs. After such paragraphs is: "[SWE-999]" where 999 is any 3 digit number. I'd like to copy each occurrence of these. That is, the [SWE-999] statement and its prior paragraph into an excel spreadsheet. The [SWE-999] statement is typically at the end of the paragraph (with no period after it) but can sometimes be embedded within the paragraph with a list of requirements after it (e.g., "a. XYZ, b. XYZ , c. XYZ). I'm fine copying those in by hand if necessary!

Whenever I run the code, my output spreadsheet contains the page footers that contain hyperlinks (????). What I have thus far is:


Sub FindSWEText()
'
Dim myApp As Object
Dim mySheet As Object
Dim myIndex As Integer
Const Pattern As Variant = "(/[)(*)(/])" 'Find SWE Text
Dim myRange As Range
myIndex = 1
Set myRange = ActiveDocument.Range
With myRange.Find
Do While .Execute(FindText:=Pattern, MatchWildcards:=True)
If .Found Then
myRange.Expand Unit:=wdParagraph
myRange.Copy
myRange.Collapse wdCollapseEnd
If mySheet Is Nothing Then
Set myApp = CreateObject("Excel.Application")
Set mySheet = myApp.workbooks.Open("C:\Users\myname\Desktop\OUTPUT\My_Output").Sheets("Sheet1")
myIndex = 1
End If
mySheet.Cells(myIndex, 1).Select
mySheet.Paste
myIndex = myIndex + 1
If mySheet Is Nothing Then
Set myApp = CreateObject("Excel.Application")
Set mySheet = myApp.workbooks.Open("C:\Users\myname\Desktop\OUTPUT\My_Output").Sheets("Sheet1")
myIndex = 1
End If
End If
Loop
End With
If Not mySheet Is Nothing Then
myApp.workbooks(1).Close True
myApp.Quit
Set mySheet = Nothing
Set myApp = Nothing
End If
Set myRange = Nothing
End Sub

If you have any suggestions, I'd be most appreciative! Thank you!

[gmaxey]

Your pattern is wrong and could be refined: Const Pattern As Variant = "\[SWE [0-9]{3}\]" 'Find SWE Text

[gmayor]

Greg - you forgot the hyphen ;)
Aerogal -
If your description of the paragraphs is accurate then the following will extract the paragraph up to and including the tagged numbers in column 1 and will split any text after the tagged numbers at the commas into additional columns. I have added error correction for missing files and folders to enable it to work on any PC.

Option Explicit

Sub FindSWEText()
Const Pattern As String = "\[SWE-[0-9]{3}\]"
Dim myRange As Range
Dim myApp As Object
Dim myBook As Object
Dim mySheet As Object
Dim myIndex As Long: myIndex = 1
Dim strList() As String
Dim i As Long
Dim fso As Object
Dim strPath As String: strPath = Environ("USERPROFILE") & "\Desktop\OUTPUT\"
Set myRange = ActiveDocument.Range
Set myApp = CreateObject("Excel.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(strPath) Then MkDir strPath
If fso.FileExists(strPath & "My_Output.xlsx") Then
Set myBook = myApp.workbooks.Open(strPath & "My_Output.xlsx")
Else
Set myBook = myApp.workbooks.Add
myBook.SaveAs strPath & "My_Output.xlsx"
End If
Set mySheet = myBook.Sheets("Sheet1")
myApp.Visible = True 'while testing

With myRange.Find
Do While .Execute(FindText:=Pattern, MatchWildcards:=True)
myRange.start = myRange.Paragraphs(1).Range.start
myRange.start = myRange.Paragraphs(1).Range.start
mySheet.Cells(myIndex, 1) = myRange.Text
myRange.Collapse wdCollapseEnd
If Not myRange.End = myRange.Paragraphs(1).Range.End - 1 Then
myRange.End = myRange.Paragraphs(1).Range.End - 1
strList = Split(myRange.Text, ",")
For i = 0 To UBound(strList)
mySheet.Cells(myIndex, i + 2) = Trim(strList(i))
Next i
End If
myRange.Collapse wdCollapseEnd
myIndex = myIndex + 1
Loop
End With
If Not mySheet Is Nothing Then
myApp.workbooks(1).Close True
myApp.Quit
Set mySheet = Nothing
Set myApp = Nothing
End If
Set myRange = Nothing
Set fso = Nothing
End Sub

[gmaxey]

Graham,

Yes I did grr. Did you mean to repeat these lines:
myRange.start = myRange.Paragraphs(1).Range.start
myRange.start = myRange.Paragraphs(1).Range.start

[Aerogal]

Greg and Graham, thank you so very much! It works! I was on vacation for 2 weeks and just returned. This will save me an enormous amount of time. I knew that my pattern could be refined, but I was getting pretty frustrated. Thanks again. :clap:

[gmaxey]

Aerogal,

You're welcome. Who now is Maryland's favorite son?

[Aerogal]

Ummmm...... Cal? Has it changed?

[gmaxey]

Ah, I had forgotten about Cal Ripken (I'm not from Maryland) and you must not follow Olympic swimming or care for Michael Phelps.

[Aerogal]

Well you are right! And yes I do follow the olympics but primarily woman's gymnastics (yay team). Also diving! My husband was interested in how Michael Phelps would do, but I was pretty much.. Meh.:hi:

Thanks again for all your help!