Sub kr_ncbi()
Dim strTemp As String, strName As String, sDelimiter As String
Dim arrNameTemp() As String
Dim i As Long
Dim ca
Dim myrange As Range
Dim krtext As String
Dim pnxtex() As String
Dim arrkrtemp As String
If selection.Range = "" Then
MsgBox "Select the text first! ", vbOKOnly
Exit Sub
End If
If InStr(selection.Text, "and") > 0 And InStr(selection.Text, ".") > 0 Then
krtext = Replace(Replace(selection.Range.Text, " and", ","), ".", "")
End If
If InStr(selection.Text, "and") = 0 And InStr(selection.Text, ".") > 0 Then
krtext = Replace(selection.Range.Text, ".", "")
End If
If InStr(selection.Text, "and") > 0 And InStr(selection.Text, ".") = 0 Then
krtext = Replace(selection.Range.Text, " and", ",")
End If
pnxtex = Split(krtext, " ")
For i = LBound(pnxtex) To UBound(pnxtex)
pnxtex(i) = delete_comma(pnxtex(i))
Next
arrkrtemp = Join(pnxtex, " ")
'MsgBox arrkrtemp
strTemp = Trim(arrkrtemp)
If Right$(strTemp, 1) = "." Or Right$(strTemp, 1) = "," _
Then strTemp = Left$(strTemp, Len(strTemp) - 1)
sDelimiter = IIf(InStr(selection.Text, ";") = 0, ",", ";")
arrNameTemp = Split(strTemp, sDelimiter)
For i = LBound(arrNameTemp) To UBound(arrNameTemp)
arrNameTemp(i) = ncbi_kr(arrNameTemp(i))
Next
strName = Join(arrNameTemp, "; ")
If selection.Next(wdCharacter, 1) = "." Then strName = Left(strName, Len(strName) - 1) 'avoid duplicate dot
'selection.TypeText (strName)
selection.Text = strName
'Call delete_double_dot_artifact
End Sub
Function ncbi_kr(kr_ncbi As String) As String
Dim arrName() As String
Dim strLastName As String, strFirstName As String
Dim i As Long, l As Long, u As Long
arrName = Split(Trim(kr_ncbi), " ")
l = LBound(arrName)
u = UBound(arrName)
If u > l Then
For i = l To u - 1
strLastName = strLastName & arrName(i) & " "
Next
For i = 1 To Len(arrName(u))
strFirstName = strFirstName & Mid$(arrName(u), i, 1) & "."
Next
ncbi_kr = Trim(strLastName) & ", " & strFirstName
Else
ncbi_kr = Trim(kr_ncbi)
End If
End Function
Private Function delete_comma(a As String)
If Len(a) < 2 Then
a = a
ElseIf Right(a, 1) = "," And Asc(Right(a, 2)) >= 97 And Asc(Right(a, 2)) <= 122 Then
a = Left(a, Len(a) - 1)
End If
'MsgBox a
delete_comma = a
End Function