This code has worked on any versions of Office, but not on 2007 and up.
It depends on CombineNames Module and CombineAddresses Module, but these are correctly identifying the fields.
Code:
Function CombineNamesAddresses$(FormName$, BaseName$)
'
'Combines upto 4 names and addresses with BaseName on Form$.
'Each address is combined to a single line.
'Names without an address are attached to the previous name.
'Duplicate addresses (for sequential entries) are treated as name only above.
'
'The name consists of these fields (all prefixed with BaseName$):
'Prefix FName Initials LName Suffix
'
'Likewise the address consists of:
'Add City State Zip
''Add' is converted to a single line.
Dim Name1, Name2, Name3, Name4 As Variant
Dim Addr1, Addr2, Addr3, Addr4 As Variant
Dim Full$
'Build all the names
Name1 = CombineName(FormName$, BaseName$ + "1")
Name2 = CombineName(FormName$, BaseName$ + "2")
Name3 = CombineName(FormName$, BaseName$ + "3")
Name4 = CombineName(FormName$, BaseName$ + "4")
'...and the addresses
Addr1 = CombineAddress(FormName$, BaseName$ + "1")
Addr2 = CombineAddress(FormName$, BaseName$ + "2")
Addr3 = CombineAddress(FormName$, BaseName$ + "3")
Addr4 = CombineAddress(FormName$, BaseName$ + "4")
'Pad out blank addresses
If IsNull(Addr1) Then Addr1 = ""
If IsNull(Addr2) Then Addr2 = Addr1
If IsNull(Addr3) Then Addr3 = Addr2
If IsNull(Addr4) Then Addr4 = Addr3
'Combine names with the same address
If Not (IsNull(Name1) Or IsNull(Name2) Or IsNull(Addr1)) Then
If (Addr2 = Addr1) Then 'Second same as first
Name1 = Name1 + " & " + Name2
Name2 = Null
End If
End If
If Not (IsNull(Name3) Or IsNull(Name4) Or IsNull(Addr3)) Then
If (Addr4 = Addr3) Then
Name3 = Name3 + " & " + Name4
Name4 = Null
End If
End If
Full$ = ""
If Not (IsNull(Name1)) Then Full$ = Name1 + ", " + Addr1
If Not (IsNull(Name2)) Then
If Full$ <> "" Then Full$ = Full$ + Chr(13) + Chr(10)
Full$ = Full$ + Name2 + ", " + Addr2
End If
If Not (IsNull(Name3)) Then
If Full$ <> "" Then Full$ = Full$ + Chr(13) + Chr(10)
Full$ = Full$ + Name3 + ", " + Addr3
End If
If Not (IsNull(Name4)) Then
If Full$ <> "" Then Full$ = Full$ + Chr(13) + Chr(10)
Full$ = Full$ + Name4 + ", " + Addr4
End If
CombineNamesAddresses$ = Full$
End Function