kerrypnx
2/7/2018 - 7:38 AM

NCBI-2018-2-7

NCBI-2018-2-7

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