Need Algorithm to return list of intermediate ranges

[Tony Strazzeri]

My mind is not working well at the moment and I need some help to
create an algorithm to do as follows. I have jurie-rigged some
working code but frankly I am embarassed to make it public.

Any help with an elegant approach will be much appreciated.

Cheers
TonyS.

I need to be able to generate a list of number pairs representing a
range of values that fall in-between the specified value pairs.

To be more precise, this is a list or Microsoft Word document ranges.
The labels "Choice" and "Nested_Itm" represent bookmark ranges.

When option "Ch_B3" is selected I iterate through all bookmarks that
fall within the range of the specified bookmark. The following is the
list of values that are returned.

Choice | Nested_Itm | Start | End |
--------------------------------------------------------------------------
Ch_B3 | | 1003 | 1768 |
| Ch_A2 | 911 | 3148 |
| Ch_B3 | 1003 | 1768 |
| Ch_C1 | 1234 | 1521 |
| Ch_D1 | 1376 | 1412 |
| Ch_E1 | 1378 | 1400 |
| Ch_F1 | 1390 | 1495 |
| Ch_D2 | 1525 | 1528 |
| Ch_D3 | 1540 | 1550 |
| Ch_C2 | 1568 | 1761 |
--------------------------------------------------------------------------

This table represents the Start and End position of every bookmark
within the Chosen bookmark. Word considers any bookmark whose range
starts, ends or traverses the specified bookmark to be within the
selected bookmark.

The list is sorted from lowest to highest start point.

The following may not be readily apparent but is true about the list.
1. Selected bookmark is Ch_B3 which starts at 1003 and ends at 1768.
2. Ch_A2 starts before and ends after the selected bookmark.
3. Ch_B3 is shown again (at line 2 of the list) because it is the next
bookmark with a start point greater than Ch_A2.
4. Ch_C1 is nested (one level) inside Ch_B3 (because it starts and
ends within B3's range)
5. Ch_D1 is fully nested inside Ch_C1 as are D1, D2, D3, E1 and F1
(because they all start and end within C1's range).
6. Ch_C2 is nested (one level) inside Ch_B3 (like C1)

Any items nested more than one level deep (eg items in point 5) can be
ignored as they are encompassed by their parent nested item.

The result I need is an algorithm that processes the above list and
returns a set of ranges (start/end locations) representing the space
between the start and end of the selected item's range but excluding
the ranges represented by the nested ranges.

The above example should therefore return a list as follows;
Start End
1003 1234
1521 1525
1528 1540
1550 1568
1761 1768

Thanks!

P.S. Apologies if this appears twice. I reposted several hours later
when I thought it had not gone through.

 

[Helmut Weber]

Hi Tony,

this is not half the way,
but if it helps, it is alright,
otherwise, disregard.

I think, it is all about to utilize the inrange.method.

Sub Macro2()
Dim rTmp As Range
Dim tBkm As Bookmark
Dim lStr() As Long
Dim lEnd() As Long
Dim lLng() As Long
Dim x As Long

Set rTmp = ActiveDocument.Bookmarks("Bkm0").Range
ReDim lStr(1 To rTmp.Bookmarks.Count) ' start
ReDim lEnd(1 To rTmp.Bookmarks.Count) ' end
ReDim lLng(1 To rTmp.Bookmarks.Count) ' length

' put in array
For Each tBkm In rTmp.Bookmarks
x = x + 1
If tBkm.Range.InRange(rTmp) Then
lStr(x) = tBkm.Range.Start
lEnd(x) = tBkm.Range.End
lLng(x) = Len(tBkm.Range)
Debug.Print lStr(x), lEnd(x), lLng(x)
End If
Next
End Sub

Now you got all the data for further processing.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Tony Strazzeri]

Hi Tony,

this is not half the way,
but if it helps, it is alright,
otherwise, disregard.

Hi Helmut,
Thanks for the response.

Sorry mate but it the suggested code only achieves the same as my
starting point.

That is the list it produces is the list I started with. The .InRange
method doesn't make any difference.

Cheers
TponyS.

 

[Helmut Weber]

Hi Tony,

lack of testing material,
one of the most sophisticated questions I've come across.

I can't offer a solution, just thoughts.

Sub Macro3()
Dim RefBkm0 As Bookmark ' reference bookmark's range
Dim TmpBkm1 As Bookmark ' temporary bookmark's range level 1
Dim TmpBkm2 As Bookmark ' temporary bookmark's range level 2
Set RefBkm0 = ActiveDocument.Bookmarks("Bkm0")
For Each TmpBkm1 In RefBkm0.Range.Bookmarks
If TmpBkm1.Range.InRange(RefBkm0.Range) Then
For Each TmpBkm2 In TmpBkm1.Range.Bookmarks
If TmpBkm2.Range.InRange(TmpBkm1.Range) Then
' do nothing or if not if you like then without "else"
Else
Debug.Print TmpBkm2.Range.Start, TmpBkm2.Range.End
End If
Next
End If
Next
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Russ]

Tony,
This seems to output the numbers you need. You still need to sort the output
and pair the numbers to make ranges.

Sub FindRangeGaps()
Dim SaveRangeStart As Boolean
Dim SaveRangeStart2 As Boolean
Dim SaveRangeEnd As Boolean
Dim SaveRangeEnd2 As Boolean
Dim RefBkm0 As Bookmark ' reference bookmark's range
Dim TmpBkm1 As Bookmark ' temporary bookmark's range level 1
Dim TmpBkm2 As Bookmark ' temporary bookmark's range level 2

Set RefBkm0 = ActiveDocument.Bookmarks("CH_B3")

For Each TmpBkm1 In RefBkm0.Range.Bookmarks
SaveRangeStart = True
SaveRangeStart2 = True
SaveRangeEnd = True
SaveRangeEnd2 = True
For Each TmpBkm2 In RefBkm0.Range.Bookmarks
If Not TmpBkm1.Range.IsEqual(TmpBkm2.Range) And _
Not TmpBkm2.Range.IsEqual(RefBkm0.Range) Then
If Not TmpBkm1.Range.Characters.First.InRange(RefBkm0.Range) _
Or TmpBkm1.Range.Characters.First.InRange(TmpBkm2.Range) _
And TmpBkm2.Range.Characters.First.InRange(RefBkm0.Range) _
And Not TmpBkm1.Range.Start = RefBkm0.Range.Start Then
SaveRangeStart2 = False
End If
If Not TmpBkm1.Range.Characters.Last.InRange(RefBkm0.Range) Or _
TmpBkm1.Range.Characters.Last.InRange(TmpBkm2.Range) And _
TmpBkm2.Range.Characters.Last.InRange(RefBkm0.Range) And _
Not TmpBkm1.Range.End = RefBkm0.Range.End Then
SaveRangeEnd2 = False
End If
SaveRangeStart = SaveRangeStart And SaveRangeStart2
SaveRangeEnd = SaveRangeEnd And SaveRangeEnd2
End If
Next TmpBkm2
If SaveRangeStart Then
Debug.Print TmpBkm1.Range.Start
End If
If SaveRangeEnd Then
Debug.Print TmpBkm1.Range.End
End If
Next TmpBkm1
End Sub

 

[Tony Strazzeri]

Thanks for this Russ,

I am having a play with it now. I will post when I have completed
what I am trying to do.

As I said in my post, my brain is not functioning properly at the
moment. Is it possible for you to modify the procedure to store the
start and end ranges found into an array where each row has a start
and end range.

Thanks.
TonyS.

 

[Russ]

Tony,
Copy and Paste all of this new stuff over the old subroutine.
It functionally does the same as old subroutine, but also sorts the output
with a quick sort routine I found on line and parses the sorted output to
create bookmarks called Gap1,Gap2, etc. Any existing bookmark names that
start with Gap... are deleted first, to allow creating new ones each time
through.

'===========================================
Public Sub TestFindRangeGaps()
Call FindRangeGaps("Ch_B3")
End Sub
'===========================================
Sub FindRangeGaps(RefBkmName As String)
Dim SaveRangeStart As Boolean
Dim SaveRangeStart2 As Boolean
Dim SaveRangeEnd As Boolean
Dim SaveRangeEnd2 As Boolean
Dim RefBkm0 As Bookmark ' reference bookmark's range
Dim TmpBkm1 As Bookmark ' temporary bookmark's range level 1
Dim TmpBkm2 As Bookmark ' temporary bookmark's range level 2
Dim myArray() As Long
Dim myIndex As Long
Dim i As Long
Dim i2 As Long

Set RefBkm0 = ActiveDocument.Bookmarks(RefBkmName)

For Each TmpBkm1 In RefBkm0.Range.Bookmarks
SaveRangeStart = True
SaveRangeStart2 = True
SaveRangeEnd = True
SaveRangeEnd2 = True
For Each TmpBkm2 In RefBkm0.Range.Bookmarks
If Not TmpBkm1.Range.IsEqual(TmpBkm2.Range) And _
Not TmpBkm2.Range.IsEqual(RefBkm0.Range) Then
If Not TmpBkm1.Range.Characters.First.InRange(RefBkm0.Range) _
Or TmpBkm1.Range.Characters.First.InRange(TmpBkm2.Range) _
And TmpBkm2.Range.Characters.First.InRange(RefBkm0.Range) _
And Not TmpBkm1.Range.Start = RefBkm0.Range.Start Then
SaveRangeStart2 = False
End If
If Not TmpBkm1.Range.Characters.Last.InRange(RefBkm0.Range) Or _
TmpBkm1.Range.Characters.Last.InRange(TmpBkm2.Range) And _
TmpBkm2.Range.Characters.Last.InRange(RefBkm0.Range) And _
Not TmpBkm1.Range.End = RefBkm0.Range.End Then
SaveRangeEnd2 = False
End If
SaveRangeStart = SaveRangeStart And SaveRangeStart2
SaveRangeEnd = SaveRangeEnd And SaveRangeEnd2
End If
Next TmpBkm2
If SaveRangeStart Then
ReDim Preserve myArray(myIndex)
myArray(myIndex) = TmpBkm1.Range.Start
myIndex = myIndex + 1
End If
If SaveRangeEnd Then
ReDim Preserve myArray(myIndex)
myArray(myIndex) = TmpBkm1.Range.End
myIndex = myIndex + 1
End If
Next TmpBkm1
Call QuickSort(myArray)
i2 = 1
For Each TmpBkm1 In ActiveDocument.Bookmarks
If TmpBkm1.Name Like "Gap*" Then
TmpBkm1.Delete
End If
Next TmpBkm1
For i = LBound(myArray) To UBound(myArray) - 1 Step 2
ActiveDocument.Bookmarks.Add Name:="Gap" & i2, _
Range:=ActiveDocument.Range(myArray(i), myArray(i + 1))
i2 = i2 + 1
Next i
End Sub
'===========================================
Public Sub QuickSort(ByRef lngArray() As Long)
Dim iLBound As Long
Dim iUBound As Long
Dim iTemp As Long
Dim iOuter As Long
Dim iMax As Long

iLBound = LBound(lngArray)
iUBound = UBound(lngArray)

'Dont want to sort array with only 1 value
If (iUBound - iLBound) Then

'Move the largest value to the rightmost position, otherwise
'we need to check that iLeftCur does not exceed the bounds of the
'array on EVERY pass (time consuming)

For iOuter = iLBound To iUBound
If lngArray(iOuter) > lngArray(iMax) Then iMax = iOuter
Next iOuter

iTemp = lngArray(iMax)
lngArray(iMax) = lngArray(iUBound)
lngArray(iUBound) = iTemp

'Start quicksorting
InnerQuickSort lngArray, iLBound, iUBound
End If
End Sub
'===========================================
Private Sub InnerQuickSort(ByRef lngArray() As Long, ByVal iLeftEnd As _
Long, ByVal iRightEnd As Long)
Dim iLeftCur As Long
Dim iRightCur As Long
Dim iPivot As Long
Dim iTemp As Long

If iLeftEnd >= iRightEnd Then Exit Sub

iLeftCur = iLeftEnd
iRightCur = iRightEnd + 1
iPivot = lngArray(iLeftEnd)

'Arrange values so that < pivot are on the left and > pivot are on the
'right
Do
'Find >= value on left side
Do
iLeftCur = iLeftCur + 1
Loop While lngArray(iLeftCur) < iPivot

'Find <= value on right side
Do
iRightCur = iRightCur - 1
Loop While lngArray(iRightCur) > iPivot

'No more swapping to do
If iLeftCur >= iRightCur Then Exit Do

'Swap
iTemp = lngArray(iLeftCur)
lngArray(iLeftCur) = lngArray(iRightCur)
lngArray(iRightCur) = iTemp
Loop

'Call quicksort recursively on left and right subarrays
lngArray(iLeftEnd) = lngArray(iRightCur)
lngArray(iRightCur) = iPivot

InnerQuickSort lngArray, iLeftEnd, iRightCur - 1
InnerQuickSort lngArray, iRightCur + 1, iRightEnd
End Sub

Thanks for this Russ,

I am having a play with it now. I will post when I have completed
what I am trying to do.

As I said in my post, my brain is not functioning properly at the
moment. Is it possible for you to modify the procedure to store the
start and end ranges found into an array where each row has a start
and end range.

Thanks.
TonyS.