I was wondering if it would be possible to parse out an individuals first name & surname from their Windows logon name.

Obtaining the Windows logon name is easily done ( 
msgbox Environ("UserName")
) so the only real difficulty is:
  1. Correctly parse names from as many variations of a user name as possible (i.e. names separated with a full stop, names separated with an underscore etcetcera) and
  2. Ignore most standard non-individual names (e.g. Administrator, Admin, Accounts, Sales etcetcera)

A quick google search throws up many results on parsing names from cells but these don't have a good success rate on actual user name formats. Below is what I have so far.

Option Explicit
Option Private Module

Private strEnvironUserName As String

Public Sub test()
          Dim strName1 As String
          Dim strName2 As String
          Dim strName3 As String
          Dim strName4 As String
          Dim strName5 As String
          Dim strName6 As String

          'John Citizen is the dummy name for testing the code.
          'This will be replaced with Environ("UserName") once the code is working

10        strEnvironUserName = "John.Citizen"
20        strName1 = ParseOutNamesFromUserName(strEnvironUserName)

30        strEnvironUserName = "John_Citizen"
40        strName2 = ParseOutNamesFromUserName(strEnvironUserName)

50        strEnvironUserName = "John Citizen"
60        strName3 = ParseOutNamesFromUserName(strEnvironUserName)

70        strEnvironUserName = "JohnCitizen"
80        strName4 = ParseOutNamesFromUserName(strEnvironUserName)

90        strEnvironUserName = "Administrator"
100       strName5 = ParseOutNamesFromUserName(strEnvironUserName)

110       strEnvironUserName = "Admin"
120       strName6 = ParseOutNamesFromUserName(strEnvironUserName)



130       MsgBox strName1 'Working
140       MsgBox strName2 'not working
150       MsgBox strName3 'Working
160       MsgBox strName4 'not working
170       MsgBox strName5 'working (and it shouldn't)
180       MsgBox strName6 'working (and it shouldn't)
End Sub

Private Function ParseOutNamesFromUserName(strEnvironUserName As String) As Variant
          ''based on ParseOutNames
          ''http://www.cpearson.com/excel/firstlast.htm
          Dim FirstName As String
          Dim LastName As String
          Dim MidInitial As String
          Dim Suffix As String
          Dim Pos As Integer
          Dim Pos2 As Integer
          Dim Pos3 As Integer

10        Pos = InStr(1, strEnvironUserName, ".", vbTextCompare)
20        If Pos = 0 Then
30            Pos = Len(strEnvironUserName) + 1
40        End If
50        LastName = Trim(Left(strEnvironUserName, Pos - 1))

60        Pos2 = InStr(1, LastName, " ", vbTextCompare)
70        If Pos2 Then
80            Pos3 = InStr(Pos2 + 1, LastName, " ", vbTextCompare)
90            If Pos3 Then
100               Suffix = Right(LastName, Len(LastName) - Pos3)
110               LastName = Left(LastName, Pos3 - 1)
120           Else
130               Suffix = Right(LastName, Len(LastName) - Pos2)
140               LastName = Left(LastName, Pos2 - 1)
150           End If
160       End If

170       Pos2 = InStr(Pos + 2, strEnvironUserName, " ", vbTextCompare)
180       If Pos2 = 0 Then
190           Pos2 = Len(strEnvironUserName)
200       End If

210       If Pos2 > Pos Then
220           FirstName = Mid(strEnvironUserName, Pos + 1, Pos2 - Pos)
230           MidInitial = Right(strEnvironUserName, Len(strEnvironUserName) - Pos2)
240       End If
          
250       Pos = InStr(1, LastName, "-", vbTextCompare)
260       If Pos Then
270           LastName = Trim(StrConv(Left(LastName, Pos), vbProperCase)) & _
              Trim(StrConv(Right(LastName, Len(LastName) - Pos), vbProperCase))
280       Else
290           LastName = Trim(StrConv(LastName, vbProperCase))
300       End If

310       FirstName = Trim(StrConv(FirstName, vbProperCase))
320       MidInitial = Trim(StrConv(MidInitial, vbProperCase))
330       Suffix = Trim(StrConv(Suffix, vbProperCase))
          '
          ' suffix handling
          '
340       Select Case UCase(Suffix)
              Case "JR", "SR", "II", "III", "IV", "MD", "PHD", "PH.D", "M.D."
          
350           Case Else
360               If Not IsNumeric(Left(Suffix, 1)) Then
370                   LastName = LastName & " " & Suffix
380                   Suffix = ""
390               End If
400       End Select
          
410       ParseOutNamesFromUserName = LastName & FirstName & MidInitial & Suffix

End Function