Luminita,
You can use a macro to sort chemical formulas. The version I've written
will sort a list starting in cell A1, extending down column A without any
gaps, and with nothing else on the sheet. As written, it will sort based on
5 element symbols, and the count of the first four elements. I'm pretty sure
it works, but would appreciate any feedback, good or bad. Copy the code into
a regular code module, then run the macro after you've imported your list.
HTH,
Bernie
MS Excel MVP
Option Explicit
Sub SortChemicalFormulas()
'Macro to sort chemical formulas in column A
'starting in cell A1.
'This will work for all chemical formulas that have
'fewer than 100 of any element.
'Elements must be in proper case: H, N, Na, Cl
'Written by Bernie Deitrick July 1, 2004
'If you use this, let me know at
' deitbe at consumer dot org
'To decipher my address, simply take out spaces
'and change the dot to a . and the at to @
Dim myCell As Range
Dim i As Integer
Dim UpperC As Boolean
Dim TwoLetter As Boolean
Dim isNum As Boolean
Dim TwoNum As Boolean
Dim Count1 As Boolean
Dim myRange As Range
For Each myCell In Range("A1").CurrentRegion
For i = 1 To Len(myCell.Value)
UpperC = False
TwoLetter = False
TwoNum = False
isNum = False
Count1 = False
'Find leading Upper Case letters or numbers
If Not IsNumeric(Mid(myCell.Value, i, 1)) Then
If Mid(myCell.Value, i, 1) = UCase(Mid(myCell.Value, i, 1)) Then
UpperC = True
End If
Else
isNum = True
End If
'Differentiate between cases like NO, N2O, NaO and Na2O
If UpperC Then
If Not IsNumeric(Mid(myCell.Value, i + 1, 1)) Then
If Mid(myCell.Value, i + 1, 1) = _
LCase(Mid(myCell.Value, i + 1, 1)) Then
TwoLetter = True
If Not IsNumeric(Mid(myCell.Value, i + 2, 1)) Then
Count1 = True
End If
Else
Count1 = True
End If
End If
End If
'Find if there are two digits after the symbol
If isNum Then
If IsNumeric(Mid(myCell.Value, i + 1, 1)) Then
TwoNum = True
End If
End If
'Write the symbols and numbers out to the sheet for later sorting
If TwoLetter Or TwoNum Then
Cells(myCell.Row, 256).End(xlToLeft)(1, 2).Value = _
Mid(myCell.Value, i, 2)
i = i + 1
If Count1 Then
Cells(myCell.Row, 256).End(xlToLeft)(1, 2).Value = 1
End If
Else
Cells(myCell.Row, 256).End(xlToLeft)(1, 2).Value = _
Mid(myCell.Value, i, 1)
If Count1 Then
Cells(myCell.Row, 256).End(xlToLeft)(1, 2).Value = 1
End If
End If
Next i
Next myCell
Set myRange = Range("A1").CurrentRegion
If Application.WorksheetFunction.CountBlank(myRange) > 0 Then
myRange.SpecialCells(xlCellTypeBlanks).Value = 0
End If
With myRange.Resize(myRange.Rows.Count, 10)
.Sort Key1:=Range("H1"), Order1:=xlAscending, _
Key2:=Range("I1"), Order2:=xlAscending, _
Key3:=Range("J1"), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
.Sort Key1:=Range("E1"), Order1:=xlAscending, _
Key2:=Range("F1"), Order2:=xlAscending, _
Key3:=Range("G1"), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
.Sort Key1:=Range("B1"), Order1:=xlAscending, _
Key2:=Range("C1"), Order2:=xlAscending, _
Key3:=Range("D1"), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
.Range(Range("B1"), Cells(1, Range("A1").CurrentRegion. _
Columns.Count)).EntireColumn.Delete
End With
End Sub
lumi said:
Hi, I want to do an index for molecular formulas. Normally I import a file
(.csv) and I have one column (text) containing:
C3H2
C12H6F3
C12H6FO2
C6H12NO2
C10H5F3 and so on
I would like to do a sorting in which C atoms are first sorted from 1-~,
then H from 1 -~ and then alphabetical order of the rest of the elements(i.e
F,N,O)in ascending order. The final list should look like:
