[Waddlek]

Originally Posted by Magnus

Hi

There are a few discussions about citation and using et. al. instead of
multiple authors. But I can not find a satisfying answer for my question. I
wonder if there is any way that with using APA style get citations to
automatically use et. al. instead of multiple authors.

I want to have the second and later citations to have et al if the authors
are more than three.

Hello,

I recognize that this is an old post, however, the problem still exists.

Here is a VBA workaround that will:
1. Search for references with 3 or more authors. The code uses the number of commas in the in text citation.
2. If that reference is used more than 1 time the code will prompt you on whether you want to modify the in text citation.
3. If the user indicates they want to modify it will place an in text citation after the built-in citation using the et al format
a. The citation will be highlighted in yellow and a bookmark will be
i. Example: (Waraich, Mazzuchi, Sarkani, & Rico, 2013) (Waraich, et al., 2013).

Code:
Option Explicit
Sub UpdateEtAl()
Dim fld As Field
Dim strOld As String
Dim strNew As String
Dim col As New Collection
Dim cnt As Variant
On Error GoTo MyErr

'Delete all EtAl bookmarks
Call DelBookMarks
'Loop through each field in current document
If ActiveDocument.Fields.Count 0 Then
For Each fld In ActiveDocument.Fields
'If the field is a reference then...
If fld.Type = 96 Then
fld.Select
'add the reference to a collection
col.Add fld.Code, CStr(fld.Code)
'If the references already exists in the collection jump to MyErr
End If
Next
End If
Exit Sub

MyErr:
'Err.Number 457 is thrown when attempting to add a duplicate item to a collection...
If Err.Number = 457 Then
'If there are 3 or more commas in the in text citation then...
If CountCharacter(fld.Result, ",") = 3 Then

'Ask if the user wants to change the reference to the et al format
If MsgBox("The reference" & Chr(13) & Chr(13) & fld.Result & Chr(13) & Chr(13) & "has been used before and appears to have 3 or more authors" & Chr(13) & Chr(13) & _
"Would you like to change it to use et al?", vbYesNo + vbCritical, "Change to et al?") = vbYes Then
'If the user answers Yes then...
'Move to the right of the reference field..
Selection.MoveRight Unit:=wdCharacter, Count:=2
'... and call the function to parse the reference the et al format
'and add the changed text after the existing reference...
Selection.TypeText Text:=" " & SetEtAl(fld.Result)
'...then select and highlight the changed text in yellow
Selection.MoveLeft Unit:=wdCharacter, Count:=Len(SetEtAl(fld.Result)), Extend:=wdExtend
Options.DefaultHighlightColorIndex = wdYellow
Selection.Range.HighlightColorIndex = wdYellow
'Increment the counter for naming EtAl bookmarks
cnt = cnt + 1
'Then add a bookmark using the name "EtAl" & Format(cnt, "0000")
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:="EtAl" & Format(cnt, "0000")
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
End If
End If
End If
'Then move to the next field in the original loop
Resume Next
End Sub

Public Function SetEtAl(ByVal strReference As String) As String
Dim First As String
Dim Last As String


First = Left(strReference, InStr(strReference, ","))
Last = Right(strReference, Len(strReference) - InStrRev(strReference, ",") + 1)
SetEtAl = First & " et al." & Last
End Function

Public Function CountCharacter(ByVal str As String, ByVal ch As String) As Integer
Dim cnt As Integer
Dim c As Variant
For c = 1 To Len(str)
If Mid(str, c, 1) = ch Then
cnt = cnt + 1
End If
Next
CountCharacter = cnt
End Function


Sub DelBookMarks()
Dim x As Bookmark
'Loop through bookmarks, deleting any that begin with EtAl
For Each x In ActiveDocument.Bookmarks
If Left(x.Name, 4) = "EtAl" Then
x.Delete
End If
Next
End Sub