Solved

Help working with Array

Posted on 2013-10-31
2
291 Views
Last Modified: 2013-11-01
Hi experts

I'm not very familiar with working with arrays, so I'm hoping you can help.

I have some code that is building an array of text inside my document that is contained in brackets and is the length of one word. I want to add another condition that checks to see if I've already got that word in my array, and if so, skip.

Below is my code - I've placed commented text where I'd need this to go :  '''''if strWord already exists in this array then skip over

How would I do that?

Function ReturnBracketArray() As String()
  
    Dim strWord As String
    Dim aBracketText() As String
    Dim iCount As Long
    Dim lngIndex As Long
    Dim vSplit As Variant
    Dim bTest As Boolean

    On Error GoTo ReturnArray_Err
    
    lngIndex = 0
    Set objdoc = ActiveDocument
    Set objSelection = objdoc.Range
    
    
    objSelection.Find.Forward = True
    objSelection.Find.MatchWildcards = True
    objSelection.Find.Text = "\(*\)"
    
    Do While True
        objSelection.Find.Execute
        If objSelection.Find.Found Then
            strWord = objSelection.Text
            strWord = Replace(Replace(strWord, "(", ""), ")", "")
            strWord = Replace(Replace(strWord, Chr(145), ""), Chr(146), "")
            ReDim aBracketText(0 To 2)
            bTest = CountWords(strWord, iCount, vSplit)
            If iCount < 2 Then
                MsgBox strWord
                '''''if strWord already exists in this array then skip over
                aBracketText(lngIndex) = strWord
                lngIndex = lngIndex + 1
            End If
        Else
            Exit Do
        End If
    Loop
    
   ' Resize to current value of lngIndex - 1.
   ReDim Preserve aBracketText(0 To lngIndex - 1)
   ReturnBracketArray = aBracketText

ReturnArray_End:
   Exit Function

ReturnArray_Err:
   ' If upper bound is exceeded, enlarge array.
   If Err.Number = 9 Then ' Subscript out of range
      ' Double the size of the array.
      ReDim Preserve aBracketText(lngIndex * 2)
      Resume
   Else
      MsgBox "An unexpected error has occurred!", vbExclamation
      Resume ReturnArray_End
   End If


End Function

Function CountWords(sInput As String, iWords As Long, vWords As Variant) As Boolean
vWords = Split(sInput, " ")
iWords = UBound(vWords) + 1 - LBound(vWords)
CountWords = True
End Function

Open in new window

0
Comment
Question by:Fi69
2 Comments
 
LVL 50

Accepted Solution

by:
Rgonzo1971 earned 500 total points
ID: 39616053
Hi,

pls try the Dictionary Object ( do not forget the reference to the MS Scripting runtime

Function ReturnBracketArray() As String()
  
    Dim strWord As String
    Dim aBracketText() As String
    Dim iCount As Long
    Dim lngIndex As Long
    Dim vSplit As Variant
    Dim bTest As Boolean
    Dim dict As New Scripting.Dictionary

    On Error GoTo ReturnArray_Err
    
    lngIndex = 0
    Set objdoc = ActiveDocument
    Set objSelection = objdoc.Range
    
    
    objSelection.Find.Forward = True
    objSelection.Find.MatchWildcards = True
    objSelection.Find.Text = "\(*\)"
    
    Do While True
        objSelection.Find.Execute
        If objSelection.Find.Found Then
            strWord = objSelection.Text
            strWord = Replace(Replace(strWord, "(", ""), ")", "")
            strWord = Replace(Replace(strWord, Chr(145), ""), Chr(146), "")
'            ReDim aBracketText(0 To 2)
            bTest = CountWords(strWord, iCount, vSplit)
            If iCount < 2 And Not dict.Exists(strWord) Then
                MsgBox strWord
                dict.Add strWord, strWord
                aBracketText(lngIndex) = strWord
                lngIndex = lngIndex + 1
                ReDim Preserve aBracketText(0 To lngIndex - 1)
            End If
        Else
            Exit Do
        End If
    Loop
    
   ' Resize to current value of lngIndex - 1.
'   ReDim Preserve aBracketText(0 To lngIndex - 1)
   ReturnBracketArray = aBracketText

ReturnArray_End:
   Exit Function

ReturnArray_Err:
   ' If upper bound is exceeded, enlarge array.
   If Err.Number = 9 Then ' Subscript out of range
      ' Double the size of the array.
      ReDim Preserve aBracketText(lngIndex * 2)
      Resume
   Else
      MsgBox "An unexpected error has occurred!", vbExclamation
      Resume ReturnArray_End
   End If


End Function

Function CountWords(sInput As String, iWords As Long, vWords As Variant) As Boolean
vWords = Split(sInput, " ")
iWords = UBound(vWords) + 1 - LBound(vWords)
CountWords = True
End Function

Open in new window

Regards
0
 

Author Closing Comment

by:Fi69
ID: 39616401
Thank you for that. To get that to work I've added Error Handling as if the word exists in the dictionary it errors.
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft Word is a program we have all encountered at some point, but very few of us have dug deep into its full scope of features, let alone customized it to suit our needs. Luckily making the ribbon (aka toolbar, first introduced in Word 2007) wo…
This article describes how to use the Send to Mail Recipient command. The instructions apply generally to Office 2007 and later versions, but Microsoft® Word 2013 was used for the specific steps and figures.  What is Send to Mail Recipient? Send…
This video walks the viewer through the process of creating a watermark for their document, customizing it, and saving it for viewing/printing needs.
This video walks the viewer through the process of creating envelopes and labels, with multiple names and addresses. Navigate to the “Start Mail Merge” button in the Mailings tab: Follow the step-by-step process until asked to find the address doc…

860 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question