Solved

Help working with Array

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

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
help with flyer 3 67
Microsoft Word Add-in Start automatically 8 46
MS Word Office 365 Mail Merge 2 48
Help with Word VBA class module 4 35
Preface: When I started this series, I used the term CommandBars because that is the Office Object class that it discusses. Unfortunately, when Microsoft introduced Office 2007, they replaced the standard Commandbar menus with "The Ribbon" and rem…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
This video walks the viewer through the process of creating an MLA formatted document, as well as a bibliography with citations.
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…

919 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

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now