I recently did up a spreadsheet to figure out recording time left on
DVD-Rs. It would be neat to have in this same workbook template a
sheet for converting roman numerals to modern numbers for the
copyright of the programs/movies. Is this possible to do? Those
dates can get pretty long and I'd like to just use modern numbers for
my movie catalogue so having this sheet would be extremely useful.
Tx.

David Peterson posted this code that he'd snipped from an unknown
source.

Option Explicit
Function Arabic(Roman)
'Declare variables
Dim Arabicvalues() As Integer
Dim convertedvalue As Long
Dim currentchar As String * 1
Dim i As Integer
Dim message As String
Dim numchars As Integer


'Trim argument, get argument length, and redimension array
Roman = LTrim(RTrim(Roman))
numchars = Len(Roman)
If numchars = 0 Then 'if arg is null, we're outta here
Arabic = ""
Exit Function
End If


ReDim Arabicvalues(numchars)
'Convert each Roman character to its Arabic equivalent
'If any character is invalid, display message and exit
For i = 1 To numchars
currentchar = Mid(Roman, i, 1)
Select Case UCase(currentchar)
Case "M": Arabicvalues(i) = 1000
Case "D": Arabicvalues(i) = 500
Case "C": Arabicvalues(i) = 100
Case "L": Arabicvalues(i) = 50
Case "X": Arabicvalues(i) = 10
Case "V": Arabicvalues(i) = 5
Case "I": Arabicvalues(i) = 1
Case Else
Arabic = "Sorry, " & Roman & " is not a valid Roman numeral!
"
Exit Function
End Select
Next i


'If any value is less than its neighbor to the right,
'make that value negative
For i = 1 To numchars - 1
If Arabicvalues(i) < Arabicvalues(i + 1) Then
Arabicvalues(i) = Arabicvalues(i) * -1
End If
Next i
'Build Arabic total
For i = 1 To numchars
Arabic = Arabic + Arabicvalues(i)
Next i


End Function



--

Regards,

Tom Ogilvy




"StargateFan" wrote in message
...
I recently did up a spreadsheet to figure out recording time left on
DVD-Rs. It would be neat to have in this same workbook template a
sheet for converting roman numerals to modern numbers for the
copyright of the programs/movies. Is this possible to do? Those
dates can get pretty long and I'd like to just use modern numbers for
my movie catalogue so having this sheet would be extremely useful.
Tx.

Hi, this is great, thanks. How do we use it? It doesn't appear in
the macros for this workbook though when I open the VB editor, it is
there?

Tx. :oD

------------------------------------------------------------
On Thu, 8 Sep 2005 08:54:27 -0400, "Tom Ogilvy"
wrote:

David Peterson posted this code that he'd snipped from an unknown
source.

Option Explicit
Function Arabic(Roman)
'Declare variables
Dim Arabicvalues() As Integer
Dim convertedvalue As Long
Dim currentchar As String * 1
Dim i As Integer
Dim message As String
Dim numchars As Integer


'Trim argument, get argument length, and redimension array
Roman = LTrim(RTrim(Roman))
numchars = Len(Roman)
If numchars = 0 Then 'if arg is null, we're outta here
Arabic = ""
Exit Function
End If


ReDim Arabicvalues(numchars)
'Convert each Roman character to its Arabic equivalent
'If any character is invalid, display message and exit
For i = 1 To numchars
currentchar = Mid(Roman, i, 1)
Select Case UCase(currentchar)
Case "M": Arabicvalues(i) = 1000
Case "D": Arabicvalues(i) = 500
Case "C": Arabicvalues(i) = 100
Case "L": Arabicvalues(i) = 50
Case "X": Arabicvalues(i) = 10
Case "V": Arabicvalues(i) = 5
Case "I": Arabicvalues(i) = 1
Case Else
Arabic = "Sorry, " & Roman & " is not a valid Roman numeral!
"
Exit Function
End Select
Next i


'If any value is less than its neighbor to the right,
'make that value negative
For i = 1 To numchars - 1
If Arabicvalues(i) < Arabicvalues(i + 1) Then
Arabicvalues(i) = Arabicvalues(i) * -1
End If
Next i
'Build Arabic total
For i = 1 To numchars
Arabic = Arabic + Arabicvalues(i)
Next i


End Function



--

Regards,

Tom Ogilvy




"StargateFan" wrote in message
.. .
I recently did up a spreadsheet to figure out recording time left on
DVD-Rs. It would be neat to have in this same workbook template a
sheet for converting roman numerals to modern numbers for the
copyright of the programs/movies. Is this possible to do? Those
dates can get pretty long and I'd like to just use modern numbers for
my movie catalogue so having this sheet would be extremely useful.
Tx.

Make sure it's in a General module.

Then you can use it like any other worksheet function:

=arabic(a1)
(if A1 was the cell that contained the Roman numerals)
or
=arabic("IV")

====
You can even use it in another workbook (if you open the workbook with the
code):

=otherworkbookname.xls!arabic(a1)



StargateFan wrote:

Hi, this is great, thanks. How do we use it? It doesn't appear in
the macros for this workbook though when I open the VB editor, it is
there?

Tx. :oD

------------------------------------------------------------
On Thu, 8 Sep 2005 08:54:27 -0400, "Tom Ogilvy"
wrote:

David Peterson posted this code that he'd snipped from an unknown
source.

Option Explicit
Function Arabic(Roman)
'Declare variables
Dim Arabicvalues() As Integer
Dim convertedvalue As Long
Dim currentchar As String * 1
Dim i As Integer
Dim message As String
Dim numchars As Integer


'Trim argument, get argument length, and redimension array
Roman = LTrim(RTrim(Roman))
numchars = Len(Roman)
If numchars = 0 Then 'if arg is null, we're outta here
Arabic = ""
Exit Function
End If


ReDim Arabicvalues(numchars)
'Convert each Roman character to its Arabic equivalent
'If any character is invalid, display message and exit
For i = 1 To numchars
currentchar = Mid(Roman, i, 1)
Select Case UCase(currentchar)
Case "M": Arabicvalues(i) = 1000
Case "D": Arabicvalues(i) = 500
Case "C": Arabicvalues(i) = 100
Case "L": Arabicvalues(i) = 50
Case "X": Arabicvalues(i) = 10
Case "V": Arabicvalues(i) = 5
Case "I": Arabicvalues(i) = 1
Case Else
Arabic = "Sorry, " & Roman & " is not a valid Roman numeral!
"
Exit Function
End Select
Next i


'If any value is less than its neighbor to the right,
'make that value negative
For i = 1 To numchars - 1
If Arabicvalues(i) < Arabicvalues(i + 1) Then
Arabicvalues(i) = Arabicvalues(i) * -1
End If
Next i
'Build Arabic total
For i = 1 To numchars
Arabic = Arabic + Arabicvalues(i)
Next i


End Function



--

Regards,

Tom Ogilvy




"StargateFan" wrote in message
.. .
I recently did up a spreadsheet to figure out recording time left on
DVD-Rs. It would be neat to have in this same workbook template a
sheet for converting roman numerals to modern numbers for the
copyright of the programs/movies. Is this possible to do? Those
dates can get pretty long and I'd like to just use modern numbers for
my movie catalogue so having this sheet would be extremely useful.
Tx.



--

Dave Peterson