[SRC] [Funcion] Get_Electronic_Configuration [by *PsYkE1*]

Hello, here you have a function to get the electron configuration of any element of the periodic table ... :)

Code:

---

' ////////////////////////////////////////////////////////////////
' // *Autor: *PsYkE1* [[email protected]]                    //
' // *Fecha: 20/7/10                                            //
' // *Podeis agrandar o reducir el codigo, siempre y cuando se  //
' //  respete la autoria y se me comuniquen esos cambios.      //
' // *Agradecimientos a raul338                                //
' ////////////////////////////////////////////////////////////////

Option Explicit

Public Function Get_Electronic_Configuration(ByVal bElementValence As Byte) As Collection

    Const ELECTRONIC_CONF        As String = "1s,2s,2p,3s,3p,4s,3d,4p,5s,4d,5p,6s,4f,5d,6p,7s,5f,6d"
    Const EXCEPTION_VALENCES_A  As String = "24,29"              '# Cr & Cu
    Const EXCEPTION_VALENCES_B  As String = "41,42,44,45,46,47"  '# Zr, Nb, Tc, Ru, Rh, Pd & Ag
    Const EXCEPTION_VALENCES_C  As String = "78,79"              '# Pt & Au
   
    Const LIMIT_SUBLEVEL_S  As Byte = 2
    Const LIMIT_SUBLEVEL_P  As Byte = 6
    Const LIMIT_SUBLEVEL_D  As Byte = 10
    Const LIMIT_SUBLEVEL_F  As Byte = 14
   
    Dim cTemp              As New Collection
    Dim sSubLevel()        As String
    Dim sActualItem        As String * 2
    Dim bInvalidValenceA    As Boolean
    Dim bInvalidValenceB    As Boolean
    Dim bInvalidValenceC    As Boolean
    Dim bElectron          As Byte
    Dim bActualLimit        As Byte
    Dim x                  As Byte
    Dim n                  As Byte
    Dim y                  As Byte
   
    If bElementValence > 0 And bElementValence < 112 Then
        sSubLevel() = Split(ELECTRONIC_CONF, ",")
           
        bInvalidValenceA = CBool (InStr(EXCEPTION_VALENCES_A, CStr(bElementValence)) > 0)
        bInvalidValenceB = CBool (InStr(EXCEPTION_VALENCES_B, CStr(bElementValence)) > 0)
        bInvalidValenceC = CBool (InStr(EXCEPTION_VALENCES_C, CStr(bElementValence)) > 0)
       
        For x = 0 To UBound(sSubLevel())
            sActualItem = sSubLevel(x)
           
            Select Case Right$(sActualItem, 1)
                Case "s": bActualLimit = LIMIT_SUBLEVEL_S
                Case "p": bActualLimit = LIMIT_SUBLEVEL_P
                Case "d": bActualLimit = LIMIT_SUBLEVEL_D
                Case "f": bActualLimit = LIMIT_SUBLEVEL_F
            End Select
           
            For y = 1 To bActualLimit
                If n <> bElementValence Then n = n + 1 Else Exit For

                If (sActualItem = "4s" And bInvalidValenceA = True) Or (sActualItem = "5s" And bInvalidValenceB = True) Or _
                sActualItem = "6s" And bInvalidValenceC = True Then
                    bElectron = 1
                    Exit For
                Else
                    bElectron = bElectron + 1
                End If
            Next y

            cTemp.Add sActualItem & CStr(bElectron)
           
            If n = bElementValence Then Exit For
            bElectron = 0
        Next x
        Set Get_Electronic_Configuration = cTemp
    End If
End Function

---

So you can see an example:

Code:

---

Private Sub Form_Load()
    Dim sResult        As String
    Dim vItem          As Variant
    Dim z              As Byte
   
    z = 29 '# El Copper [Cu]
   
    For Each vItem In Get_Electronic_Configuration(z)
        sResult = sResult & vItem & " "
    Next vItem
   
    Debug.Print sResult
End Sub

---

It returns me this:

Quote:

---

1s2 2s2 2p6 3s2 3p6 4s1 3d10

---

If the variable I put 97 (Berkelium [Bk]) gives me this:

Quote:

---

1s2 2s2 2p6 3s2 3p6 4s2 3d10 4p6 5s2 4d10 5p6 6s2 4f14 5d10 6p6 7s2 5f9

---

See you :wave:

Now, if I only had this when I was in highschool during Chemistry class... :) Cool!