Sorting roman numerals in Excel

[harky]

Hi,

Can anyone tell me how I can automatically sort roman numerals within Excel. It would be straightforward enough if the roman numerals were the only text in the cells but they aren't. The text is structured like this:

TEST P-b(stat).doc
TEST P-c(stat).doc
TEST R-ii (stat).doc
TEST R-v (stat).doc
TEST R-iv (stat).doc
TEST R-iii(stat).doc
TEST R-i(stat).doc

so I need to first sort it alphabetically, TEST P before TEST R, and then the R entries sorted according to the roman numerals:

TEST P-b(stat).doc
TEST P-c(stat).doc
TEST R-i (stat).doc
TEST R-ii (stat).doc
TEST R-iii (stat).doc
TEST R-iv(stat).doc
TEST R-v(stat).doc

etc.

Anyone any ideas?

Thanks in advance

 

[PHV]

You may consider adding a column with only the roman numeral part and then sort on the two cols.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[harky]

Hi PHV, thanks for your reply

I don't think that's an option as the data is already supplied, and to create separate columns and insert the roman numeral would prove too time-consuming, there are hundreds of entries

 

[SkipVought]

What Roman Numerial is b???
[tt]
TEST P-b(stat).doc
[/tt]

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[harky]

it's not a roman numeral, the text is mixed with a, b, c for subdivisions and i, ii, iii, iv etc for subdivisions

 

[Zathras]

I may have had too much coffee this morning, but when I sorted your test data, it came out the way you said you wanted. It seems to me that it will be ok for Roman numerals up to viii. You're going to have to give us better test data to work with before we can really help you.

 

[SkipVought]

well then what's the diffrence between alpha c, d, i & roman numeral c, d, i etc?

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[harky]

Hi Zathras

try this:
HIREL A-a(narr).doc
HIREL G (narr).doc
HIREL H (narr).doc
HIREL P-a(stat).doc
HIREL P-b(stat).doc
HIREL P-c(stat).doc
HIREL R-vi (stat).doc
HIREL R-v (stat).doc
HIREL R-iv (stat).doc
HIREL R-x(stat).doc
HIREL R-ix(stat).doc
HIREL R-iii(stat).doc
HIREL R-ii(stat).doc
HIREL R-i(stat).doc
HIREL R-vii(stat).doc
HIREL R-xi(stat).doc
HIREL R-viii(stat).doc
HIREL S-a (code).doc
HIREL S-b (code).doc
HIREL S-c(code).doc
HIREL S-di(code).doc
HIREL S-dii (code).doc

the problem is it sorts according to i then v (ie alpha) I need to do a sort within a sort

 

[harky]

I don't think the users will be using roman numerals beyond xx so c, d etc won't be effected

 

[EBGreen]

What about subdivisions beyond h? Specifically i.

[blue]"Well, once again my friend, we find that science is a two headed beast. One head is nice, it gives us aspirin and other modern conveniences,...but the other head of science is BAD! Oh, beware the other head of science, Arthur; it bites!!" - The Tick[/blue]

 

[Zathras]

It would be possible for a macro to insert a temporary column, populate that column with a translated code which would sort correctly, sort, and then delete the temporary column.

But, you would need to be absolutely specific about the format of the codes and how they should be translated. It looks like the rule for finding where the RN is something like this:
1. Scan from left to right for first instance of "-"
2a. If no "-" found, then no translation required.
2b. If "-" is found then
3. Scan for the first instance of "i", "v" or "x" (first char of RN)
4. Scan for the first instance of something not "i" "v" or "x" (last char of RN)
5. Convert the RN to a 2-digit number and substitute.

The result on your latest test data becomes:
HIREL A-a(narr).doc
HIREL G (narr).doc
HIREL H (narr).doc
HIREL P-a(stat).doc
HIREL P-b(stat).doc
HIREL P-c(stat).doc
HIREL R-06 (stat).doc
HIREL R-05 (stat).doc
HIREL R-04 (stat).doc
HIREL R-10(stat).doc
HIREL R-09(stat).doc
HIREL R-03(stat).doc
HIREL R-02(stat).doc
HIREL R-01(stat).doc
HIREL R-07(stat).doc
HIREL R-11(stat).doc
HIREL R-08(stat).doc
HIREL S-a (code).doc
HIREL S-b (code).doc
HIREL S-c(code).doc
HIREL S-d01(code).doc
HIREL S-d02 (code).doc

Which results in this sort on the original data:
HIREL A-a(narr).doc
HIREL G (narr).doc
HIREL H (narr).doc
HIREL P-a(stat).doc
HIREL P-b(stat).doc
HIREL P-c(stat).doc
HIREL R-i(stat).doc
HIREL R-ii(stat).doc
HIREL R-iii(stat).doc
HIREL R-iv (stat).doc
HIREL R-v (stat).doc
HIREL R-vi (stat).doc
HIREL R-vii(stat).doc
HIREL R-viii(stat).doc
HIREL R-ix(stat).doc
HIREL R-x(stat).doc
HIREL R-xi(stat).doc
HIREL S-a (code).doc
HIREL S-b (code).doc
HIREL S-c(code).doc
HIREL S-di(code).doc
HIREL S-dii (code).doc

 

[Zathras]

Ok, try this:

(Sorry for the wide post, but the constant declaration requires it.)

Option Explicit

Sub test()
  SortRoman Range("MyRange")
End Sub

Sub SortRoman(UserRange As Range, Optional ColumnNumber As Integer = 1)[green]
' Assumes the user range includes a row of column headers[/green]
Dim SortRange As Range
Dim nRow As Long

    Application.ScreenUpdating = False[green]
     
    ' Insert sort work column in front of UserRange[/green]
    UserRange.Columns(1).Insert Shift:=xlToRight[green]
    
    ' Set sort range to include the work column[/green]
    Set SortRange = Union(UserRange, UserRange.Columns(1).Offset(0, -1))
    With SortRange[green]
      ' Populate the work column from the column to sort on[/green]
      UserRange.Columns(ColumnNumber).Copy .Columns(1)[green]
      
      ' Convert internal Roman Numerals to Arabic[/green]
      For nRow = 2 To SortRange.Rows.Count
        .Cells(nRow, 1) = ConvertInternalRomanNumerals(.Cells(nRow, 1))
      Next nRow[green]
      
      ' Sort the working range[/green]
      .Sort Key1:=SortRange.Columns(1), Order1:=xlAscending, Header:=xlYes, _
          OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom[green]
          
      ' Delete the working column[/green]
      .Columns(1).Delete Shift:=xlToLeft
    End With
    
    Application.ScreenUpdating = True
    
End Sub

Function ConvertInternalRomanNumerals(Text As String) As String[green]
' Scans the text to find an imbedded Roman numeral and converts it to Arabic
' Limitation: Only Roman numerals I to XX (1 ro 20) may be used
' Algorithm:
'   1. Scan from left to right for first instance of "-"
'   2. If "-" is found then
'   3. Scan for the first instance of "i", "v" or "x" (first char of RN)
'   4. Scan for the first instance of something not "i" "v" or "x" (last char of RN)
'   5. Convert the RN to a 2-digit number and substitute.[/green]

Dim sWork As String
Dim sTest As String
Dim sRomanNumber As String
Dim sArabicNumber As String
Dim nHyphen As Integer
Dim nI As Integer
Dim nV As Integer
Dim nX As Integer
Dim nStart As Integer
Dim nLength As Integer[green]

  ' Default to self[/green]
  sWork = Text
  [green]
  ' Find hyphen[/green]
  nHyphen = InStr(Text, "-")
  If nHyphen > 0 Then
  [green]
    ' Find first Roman Numeral character[/green]
    nI = InStr(nHyphen, Text, "i", vbTextCompare)
    nV = InStr(nHyphen, Text, "v", vbTextCompare)
    nX = InStr(nHyphen, Text, "x", vbTextCompare)
    nStart = LeastNonZero(nI, nV, nX)
    If nStart > 0 Then
    [green]
      ' Find last Roman Numeral character[/green]
      nLength = 1
      sTest = UCase(Mid(Text, nStart + nLength, 1))
      While InStr("IVX", sTest) > 0
        nLength = nLength + 1
        sTest = UCase(Mid(Text, nStart + nLength, 1))
      Wend
      [green]
      ' Extract Roman Numeral and convert to 2-character Arabic[/green]
      sRomanNumber = Mid(Text, nStart, nLength)
      sArabicNumber = Right(100 + RomanToArabic(sRomanNumber), 2)
      [green]
      ' Plug back into Text[/green]
      sWork = Left(Text, nStart - 1) + sArabicNumber + Mid(Text, nStart + nLength + 1, 999)
    End If
    
  End If[green]
  ' Return resulting string[/green]
  ConvertInternalRomanNumerals = sWork
End Function

Function LeastNonZero(ParamArray Values())
Dim i As Integer
  LeastNonZero = 0
  For i = LBound(Values) To UBound(Values)
    If Values(i) > 0 Then
      If (Values(i) < LeastNonZero) Or (LeastNonZero = 0) Then
        LeastNonZero = Values(i)
      End If
    End If
  Next i
End Function

Function RomanToArabic(ARomanNumber As String) As Integer[green]
' Quick and dirty conversion of the first 20 Roman numbers to Arabic
' Handles I thru XX only[/green]
Const ROMAN_NUMBERS = ".I.....II....III...IV....V.....VI....VII...VIII..IX....X.....XI....XII...XIII..XIV...XV....XVI...XVII..XVIII.XIX...XX...."
Dim nOffset As Integer
  nOffset = InStr(1, ROMAN_NUMBERS, "." + ARomanNumber + ".", vbTextCompare)
  RomanToArabic = (nOffset - 1) \ 6 + 1
End Function

 

[harky]

Hi Zathras,

Thanks for your help, just tried running it though and got a runtime error '1004'object _Global failed - any ideas

 

[TonyJollans]

Hi harky,

I haven't checked out the code but Zathras knows what he's doing - your error is, presumably, because you don't have a range called "MyRange" - replace it with the range you want to sort.

What the code does is extract the roman numerals from the string and builds another column and sorts on that column. Depending on what your exact format is you may well be able to do it with a single formula which would be much easier. Can you give a bit more detail about the formats?


Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.