NUMBERTOROMAN

Returns a string concatenation of Roman Numerals converted from an English Language string.

'strSource - The string containing the number to convert. Valid numbers are 1 to 3000 inclusive
'strRes - The Roman Numeral value after successful conversion
'strError - A description of why the conversion was not successful

Public Function NumberToRoman( _
    ByVal strSource As Variant, _
    ByRef strRes As Variant, _
    ByRef strError As Variant) As Boolean

Dim arRomans As Variant
Dim lposition As Long
Dim sroman As String

    On Error GoTo ErrorHandler
        
    If (NumberToRoman_Validation(strSource, strRes, strError) = False) Then
        NumberToRoman = False
        Exit Function
    End If
        
    arRomans = Array("", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX")
    Do While (VBA.Len(strSource) > 0)
        sroman = arRomans(VBA.Left(strSource, 1))
        
        Select Case VBA.Len(strSource)
            Case 2: sroman = VBA.Replace(VBA.Replace(VBA.Replace(sroman, "X", "C"), "V", "L"), "I", "X")
            Case 3: sroman = VBA.Replace(VBA.Replace(VBA.Replace(sroman, "X", "M"), "V", "D"), "I", "C")
            Case 4: sroman = VBA.Replace(sroman, "I", "M")
            Case Else:
        End Select
        
        strRes = strRes & sroman
        strSource = VBA.Right(strSource, VBA.Len(strSource) - 1)
    Loop

    strError = Empty
    NumberToRoman = True
    Exit Function
    
ErrorHandler:
    strRes = Empty
    strError = "Error"
    NumberToRoman = False
End Function

Private Function NumberToRoman_Validation( _
    ByVal strSource As Variant, _
    ByRef strRes As Variant, _
    ByRef strError As Variant) As Boolean

    On Error GoTo ErrorHandler
    NumberToRoman_Validation = False
    
    If (VBA.IsNumeric(strSource) = False) Then
        strError = "Numerical values only, no text allowed"
        Exit Function
    End If
    
    If (VBA.Val(strSource) < 0) Then
        strError = "Negative values are not allowed"
        Exit Function
    End If
    
    If (VBA.Val(strSource) < 1) Or (VBA.Val(strSource) > 3000) Then
        strError = "Numbers must be between 1 and 3000 inclusive"
        Exit Function
    End If
    
    NumberToRoman_Validation = True
    Exit Function
ErrorHandler:
    NumberToRoman_Validation = False
End Function

Returns - Boolean, True = success, False = failure
There is also a built in ROMAN function.



© 2019 Better Solutions Limited. All Rights Reserved. © 2019 Better Solutions Limited TopPrevNext