title: Find all Heading 1 Text and Put it into an Array
body: <p>I am using a VBA Macro to render all the "Heading 1" style text from a word document.
  It is working fine but taking huge time depends on the content of word doc.</p>
  
  <p>I am looping each paragraph to check for "Heading 1" style and render the Text into an array.</p>
  
  <p>I wonder if there is an alternative approach to simply find "Heading 1" style and store the text in array which would greatly reduce the execution time.</p>
  
  <p>Below my Macro program and I would appreciate any expert thoughts regarding the above mentioned.</p>
  
  <pre><code>Sub ImportWordHeadings()
  Dim wdDoc As Object
  Dim wdFileName As Variant
  Dim sHeader(50) As String
  Dim Head1counter As Integer
  Dim arrcount As Long
  Dim mHeading As String
  
  On Error Resume Next
  wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
  "Browse for file containing table to be imported")
  
  If wdFileName = False Then Exit Sub '(user cancelled import file browser)
  
  Set wdDoc = GetObject(wdFileName) 'open Word file
  
  
   p = 1
    RetCount = 0
    parg = wdDoc.Paragraphs.Count
  
  For Head1counter = 1 To parg
  
     If wdDoc.Paragraphs(Head1counter).Range.Style = "Heading 1" Then
  
          sHeader(p) = wdDoc.Paragraphs(Head1counter).Range.Text
          p = p + 1
          Else
          p = p
     End If
  Next Head1counter
  
  For arrcount = RetCount + 1 To UBound(sHeader)
  
    If sHeader(arrcount) &lt;&gt; "" Then
          Debug.Print sHeader(arrcount)
          RetCount = arrcount
  Exit For
    Else
          RetCount = RetCount
    End If
  Next arrcount
  
  Set wdDoc = Nothing
  
  End Sub
  </code></pre>