Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Help working with Array

Posted on 2013-10-31
2
Medium Priority
?
296 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 53

Accepted Solution

by:
Rgonzo1971 earned 1500 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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

This is written from a 'VBA for MS Word' perspective, but I am sure it applies to most other MS Office components where VBA is used.  One thing that really bugs me is slow code, ESPECIALLY when it's mine!  In programming there are so many ways to…
This article describes a method of delivering Word templates for use in merging Access data to Word documents, that requires no computer knowledge on the part of the recipient -- the templates are saved in table fields, and are extracted and install…
This video shows where to find the word count, how to display it, and what it breaks down to in Microsoft Word.
Learn how to make your own table of contents in Microsoft Word using paragraph styles and the automatic table of contents tool. We'll be using the paragraph styles in Word’s Home toolbar to help you create a table of contents. Type out your initial …
Suggested Courses

885 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