Solved

Help working with Array

Posted on 2013-10-31
2
292 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

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…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
This video walks the viewer through the process of creating an MLA formatted document, as well as a bibliography with citations.
This video shows where to find templates, what they are used for, and how to create and save a custom template using Microsoft Word.

685 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