VBA query - sort text in alphabetical order in Word

37 views Asked by At

I found the code below on microsoft that sorts in-text citations into alphabetical order. For example, (Gamma 2019; Beta 2011; Alpha 2009) --> (Alpha 2009; Beta 2011; Gamma 2019).

When I run the code I get a "Compile error: Wrong number of arguments or invalid property assignment".

Sub AlphaCites()
Application.ScreenUpdating = False
Dim ArrTxt() As String, i As Long, j As Long
With ActiveDocument.Content
  With .Find
    .ClearFormatting
    .Text = "\([!\(]@\)"
    .Format = False
    .Forward = True
    .MatchWildcards = True
    .Wrap = wdFindStop
  End With
  Do While .Find.Execute
    If InStr(.Text, "; ") > 0 Then
      .Start = .Start + 1
      .End = .End - 1
      j = UBound(Split(.Text, "; "))
      ReDim ArrTxt(j)
      For i = 0 To j
        ArrTxt(i) = Split(.Text, "; ")(i)
      Next
      WordBasic.SortArray ArrTxt()
      .Text = Join(ArrTxt(), "; ")
    End If
    .Collapse wdCollapseEnd
    DoEvents
  Loop
End With
End Sub

Can anyone point me to how I can troubleshoot this? The error seems to be on j = UBound(Split(.Text, "; "))

Which if I'm correct will find the upper delimiter of the array data stored in j. Perhaps the array is empty?

Regards, Steve

1

There are 1 answers

4
taller On BEST ANSWER
  • Create a variant array with aTxt = Split(.Text, "; "), then populate the string array ArrTxt() with aTxt()
Option Explicit

Sub AlphaCites()
    Application.ScreenUpdating = False
    Dim ArrTxt() As String, i As Long, j As Long
    Dim aTxt As Variant
    With ActiveDocument.Content
        With .Find
            .ClearFormatting
            .Text = "\([!\(]@\)"
            .Format = False
            .Forward = True
            .MatchWildcards = True
            .Wrap = wdFindStop
        End With
        Do While .Find.Execute
            If InStr(.Text, "; ") > 0 Then
                .Start = .Start + 1
                .End = .End - 1
                aTxt = Split(.Text, "; ")
                ReDim ArrTxt(UBound(aTxt))
                For j = 0 To UBound(aTxt)
                    ArrTxt(j) = aTxt(j)
                Next j
                WordBasic.SortArray ArrTxt()
                .Text = Join(ArrTxt(), "; ")
            End If
            .Collapse wdCollapseEnd
            DoEvents
        Loop
    End With
    Application.ScreenUpdating = True
End Sub