VBA Exception? VBA Re-Write?

buggabooed

Board Regular
Joined
Aug 17, 2012
Messages
112
I have a VBA Script in Word that looks for the information I need (a beginning of a sentence), copies the entire sentence until it hits a ".", and then repeats for all instances. I did not create this script as I'm not that awesome ( I had help from here), and it worked great until the vendor sent in wrinkles this time around. What is happening now, is that there are instances mid-sentence of things like "1.5" and such that have a period in the middle, and it is seeing that and ending the sentence right there instead of the actual end of the sentence. Is there a way around this, like an exception, or another way to do this? I'm not real VBA saavy, or really code saavy for that matter. Any help would be appreciated. Thank you. I have the script below.

Sub ExportL2RintoExcel()
'Set reference in Tools >> References to MS Excel
Dim doc As Document
'Both Word and Excel have a "range" object
'but with completely different methods and properties
'so we need to make it obvious which we're working with
Dim WDrngAll As Word.Range
Dim WDrngFind As Word.Range
Dim WDrngText As Word.Range
Dim appXL As Excel.Application
Dim XLwkb As Excel.Workbook
Dim XLwks As Excel.Worksheet
Dim x As Long, y As Long, z As Long
'Initiate objects
Set doc = ActiveDocument
Set WDrngAll = doc.Content
x = 1
z = 0
'First, count all instances of "L2R" in the text
With WDrngAll.Find
Do While .Execute(FindText:="L2R", Forward:=True) = True
z = z + 1
Loop
End With
If MsgBox("I find " & z & " instances of L2R. Does this look right? " & _
"Click Yes to continue; click No to quit.", vbYesNo) = vbYes Then

'All is good, so let's go!
'Dim an array for our info
z = z + 2
ReDim aryExport(z, 2) As String

'In Word VBA, Find searchs a range of text for a string.
'If found, that range shrinks to encompass only that string.
'So we need to set up a series of ranges: the whole doc content,
'a portion of the content to search, and the part to put in the array.
'Could probably be a bit leaner, but this keeps me away from mistakes!

'Since we searched this and found text, we don't know what it encompasses,
'so we'll reset it
Set WDrngAll = doc.Content
'Our search range is going to be reset within our loop to stretch from
'the end of the Text range to the end of the All range. This way, the
'range keeps shrinking to encompass only from the end of where we just
'came from to the end of the document. To start, then, we need a Text
'range that is just one single point at the top of the doc.
Set WDrngText = WDrngAll.Duplicate
WDrngText.Collapse wdCollapseStart

'Start the search loop
Do
'Initiate Find range
Set WDrngFind = doc.Range(WDrngText.End, WDrngAll.End)
'Find text; TRUE if found
If WDrngFind.Find.Execute(FindText:="L2R", Forward:=True) = True Then
'Found one; WDrngFind now contains only the first found "L2R"
'so we need to stretch the range to encompass the whole word
WDrngFind.MoveEnd wdWord, 1
'Load that into the array
aryExport(x, 1) = Trim(WDrngFind.Text)
'Get the text following
'(I could just keep resetting WDrngFind, but it's too prone to
'human error that I can avoid by using another range object)
Set WDrngText = doc.Range(WDrngFind.End, WDrngFind.End)
'WDrngText is now a single point at the end of the found L2R word
'Move the end forward until we see a period
WDrngText.MoveEndUntil "."
WDrngText.MoveEnd wdCharacter, 1
'Put this text into the array
aryExport(x, 2) = Trim(WDrngText.Text)

x = x + 1

'Done here; the Find range resets at the top of the loop
Else
'L2R not found; end loop
Exit Do
End If
Loop

'At this point, we should have an array full of text elements.
'In the first positions are the L2R words. In the second positions
'are all the text blocks following those words.
'Now we write into Excel.

'Check for open Excel instance; if none, create one
On Error Resume Next
Set appXL = GetObject(, "Excel.Application")
On Error GoTo 0
If appXL Is Nothing Then _
Set appXL = CreateObject("Excel.Application")
appXL.Visible = True
'Create workbook; get first sheet
Set XLwkb = appXL.Workbooks.Add
Set XLwks = XLwkb.Worksheets("Sheet1")

'Stop display updating for faster writing
appXL.ScreenUpdating = False

'Write array elements
For y = 1 To x
XLwks.Cells(y + 1, 1) = aryExport(y, 1)
XLwks.Cells(y + 1, 2) = aryExport(y, 2)
Next y

'Reset display
appXL.ScreenUpdating = True

End If
MsgBox "Done!"
End Sub
 
Most of the code is Ed's, I just replaced the loop and the method to find the no of instances of the search term.
 
Upvote 0

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
So it's working now?? Great!!
I'm not surprised mine didn't quite work right.
I've had my head stuck in an Access db for a coupla days!

Ed
 
Upvote 0
It does work and I appreciate you both helping so much.

Would there be a quicker way once the data is in Excel to slice off varying lengths of data that isn't needed past the end of the requirement?
 
Upvote 0
If you define the 'requirement' then there's probably some way to do that.
 
Upvote 0
By any chance, is there a line or paragraph break after the final period of the desired text?
 
Upvote 0
Ed - No, there isn't a line or paragraph break after the desired text. It often has several requirements on a page, then a new section with other text, then back to requirements, then a new page, then more requirements....

I'm not sure what you mean Norie.
 
Upvote 0
Ok, so I've been combing through the data results this morning from the new script you two put together for me, and have come up with the following absolutes in my data. At the end of the "." that we used to sort by, one of three situations exists now with the new script.

1 - There is a ".I-ETMS" present right after the period, just as shown with no space.
2 - There is a ". (screen x)x." right after the period, where the "x"'s represent a numerical value.
3 - There is a ".x." right after the period, with no space, where the x represents a numerical value, and can be up to two characters.

Based on that information, is there a way to limit the "junk" that is added after the period? Would there be a way to make it so it could be customizable if it changed in the future?

Thank you in advance for your all's help. I can't tell you how much I appreciate it.
 
Upvote 0
z = 2663?? That's a lot of L2R's!!
How many times does this "junk" show up?

The problem with writing code is that you need to be pretty specific. Even when you get into Regular Expressions and such, you must account for every possible variation of spaces and characters, or the code fails. Like what you ran into.

One possibility is to write something that will scan down a list of "junk flags" and see if any of those show up; if so, highlight it and let you decide at that time if it belongs or not. Because your upstream users could once again decide to change things and make those flags no longer junk.

Sometimes it's actually easier and much faster to visually scan something, because you can glance at it and know in a moment whether or not something belongs. But to write the code for every single possibility is near to impossibile!
 
Upvote 0
The junk shows up on every single instance of L2R's! Yes it is a lot of L2R's as well!!

I understand what you mean on accounting for every single instance, but I went through them yesterday and found that only those 3 variables above of junk data exist, which is why I was wondering if something could be written to account for them. You can visually scan and see them, the problem I have is once the script runs and dumps into Excel, I will still have to go through each and every cell and remove the junk data...2661 times. I know I have hogged a lot of your time and Norrid's. If you do not have time or don't think the variables can be accounted for I understand. I will just have to manually go through. I really appreciate all you two have done for me.
 
Upvote 0
The junk shows up on every single instance of L2R's! Yes it is a lot of L2R's as well!!

I understand what you mean on accounting for every single instance, but I went through them yesterday and found that only those 3 variables above of junk data exist, which is why I was wondering if something could be written to account for them. You can visually scan and see them, the problem I have is once the script runs and dumps into Excel, I will still have to go through each and every cell and remove the junk data...2661 times. I know I have hogged a lot of your time and Norrid's. If you do not have time or don't think the variables can be accounted for I understand. I will just have to manually go through. I really appreciate all you two have done for me.

My apologies...Norie. Too early when I posted this, and not enough coffee in the system yet.

What about an excel formula that I can just run over with the 3 different variables? Just kind of scrub the data a few times to truncate off everything after those 3 scenario's exist. Would that be easier?
 
Upvote 0

Forum statistics

Threads
1,215,425
Messages
6,124,825
Members
449,190
Latest member
rscraig11

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top