DZone Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

Snippets has posted 5883 posts at DZone. View Full User Profile

Excel Vba Code To Change Number Systems

08.19.2009
| 5171 views |
  • submit to reddit
        Comes very useful

Option Explicit
Public Function Hex_To_Decimal(ByVal vntHex_Value As Variant) As Variant

'
'----------------------------------------------------------------------------
' Experts Exchange Question:
' Home \ All Topics \ Applications \ MS Office \ Excel
'
'http://www.experts-exchange.com/Appl..._21547447.html
' Creating Column that does hexidecimal math
'
' Copyright (c) 2005 Clearlogic Concepts (UK) Limited
' N.Lee [ http://NigelLee.info ] - 1 September 2005
'
'----------------------------------------------------------------------------

Dim intLoop As Integer
Dim vntMultiplier As Variant
Dim vntReturn As Variant

On Error GoTo Err_Hex_To_Decimal

vntMultiplier = CDec(1)

For intLoop = Len(vntHex_Value) To 1 Step -1
vntReturn = vntReturn + CDec(vntMultiplier) * CDec("&H" & _
Mid$(vntHex_Value, intLoop, 1))
vntMultiplier = CDec(vntMultiplier * 16)
Next intLoop

Exit_Hex_To_Decimal:

On Error Resume Next

Hex_To_Decimal = vntReturn

Exit Function

Err_Hex_To_Decimal:

On Error Resume Next

vntReturn = CDec(0)

Resume Exit_Hex_To_Decimal

End Function
Public Function Decimal_To_Hex(ByVal vntDecimal_Value As Variant) As String

'
'----------------------------------------------------------------------------
' Experts Exchange Question:
' Home \ All Topics \ Applications \ MS Office \ Excel
'
'http://www.experts-exchange.com/Appl..._21547447.html
' Creating Column that does hexidecimal math
'
' Copyright (c) 2005 Clearlogic Concepts (UK) Limited
' N.Lee [ http://NigelLee.info ] - 1 September 2005
'
'----------------------------------------------------------------------------

Dim intHex_Value As Integer
Dim intLoop As Integer
Dim vntDec_Value As Variant

Dim strReturn As String

On Error GoTo Err_Decimal_To_Hex

If Len(vntDecimal_Value) > 14 Then
strReturn = "* ERROR *"
Else
strReturn = ""
vntDec_Value = CDec(vntDecimal_Value)

For intLoop = Len(vntDecimal_Value) - 1 To 0 Step -1
intHex_Value = Int(vntDec_Value / (16 ^ intLoop))
vntDec_Value = vntDec_Value - (intHex_Value * (16 ^ intLoop))
strReturn = strReturn & Hex(intHex_Value)
Next intLoop
End If

Exit_Decimal_To_Hex:

On Error Resume Next

If Left$(strReturn, 1) = "0" Then
strReturn = StrReverse(strReturn)
strReturn = StrReverse(Left$(strReturn, InStr(strReturn, "0") - 1))
End If

Decimal_To_Hex = strReturn

Exit Function

Err_Decimal_To_Hex:

On Error Resume Next

strReturn = "* ERROR *"

Resume Exit_Decimal_To_Hex

End Function