Roman Numerals

Option Explicit
 
Public Function MaxRoman(MyRange As Range) As String
Dim CellCount As Long, LoopCount As Long
Dim MyArray() As Variant, cell As Range
CellCount = MyRange.Cells.Count
ReDim MyArray(2, CellCount) As Variant
LoopCount = 0
MyArray(2, 0) = 0
For Each cell In MyRange
    LoopCount = LoopCount + 1
    MyArray(1, LoopCount) = cell.Value
    MyArray(2, LoopCount) = ConvertToDecimal(MyArray(1, LoopCount))
    If MyArray(2, LoopCount) > MyArray(2, 0) Then
        MyArray(2, 0) = MyArray(2, LoopCount)
        MyArray(1, 0) = MyArray(1, LoopCount)
    End If
Next
MaxRoman = MyArray(1, 0)
End Function
 
Public Function ConvertToDecimal(InputValue As Variant) As Long
Dim RunSum As Long, _
    LoopCount As Long, _
    NextChar As String
If Len(InputValue) = 0 Then
    ConvertToDecimal = 0
    Exit Function
End If
RunSum = 0
For LoopCount = 1 To Len(InputValue)
    If LoopCount < Len(InputValue) Then
        NextChar = Mid$(InputValue, LoopCount + 1, 1)
    Else
        NextChar = "I"
    End If
    Select Case Mid$(InputValue, LoopCount, 1)
        Case "I"
            If NextChar <> "I" Then
                RunSum = RunSum - 1
            Else
                RunSum = RunSum + 1
            End If
        Case "V"
            If NextChar <> "I" And NextChar <> "V" Then
                RunSum = RunSum - 5
            Else
                RunSum = RunSum + 5
            End If
        Case "X"
            If NextChar <> "I" And NextChar <> "V" And NextChar <> "X" Then
                RunSum = RunSum - 10
            Else
                RunSum = RunSum + 10
            End If
        Case "L"
            If NextChar = "M" Or NextChar = "D" Or NextChar = "C" Then
                RunSum = RunSum - 50
            Else
                RunSum = RunSum + 50
            End If
        Case "C"
            If NextChar = "M" Or NextChar = "D" Then
                RunSum = RunSum - 100
            Else
                RunSum = RunSum + 100
            End If
        Case "D"
            If NextChar = "M" Then
                RunSum = RunSum - 500
            Else
                RunSum = RunSum + 500
            End If
        Case "M"
            RunSum = RunSum + 1000
        Case Else
            DoEvents
    End Select
Next LoopCount
ConvertToDecimal = RunSum
End Function