UDF that runs althought not called

adulador · Mar 19, 2012

Hi,

I have a simple UDF function of myself that it is used in a worksheet as a normal function. Is the only UDF function used in the workbook as it is supposed to be used, and when called, it does what it should.

The point is that, when I debug other macros, it generally passes through the function, although is not beeing called, neither implicitly neither explicitly. It happens randomly, usually after I run the code through one point and I resume the debug process through F8 button, then, sometimes calls the function, sometimes not. It does not affect anything, just also runs that function.

Very funny and annoying. Any clues or suggestions will be wellcome

pgc01 · Mar 19, 2012

Hi
Welcome to the board

It would help if you post the code.

Maybe the udf is volatile?

adulador · Mar 19, 2012

Code:

Option Explicit

Public Function fALetra(ByRef dbValor As Double, Optional ByRef bMoneda As Boolean) As String
    Dim strSeparadorMiles As String, strSeparadorDecimales As String
    Dim strAbsoluto As String, strDecimales As String
    Dim lgAbsoluto As Long, dbDecimales As Double
    Dim strCadena As String
    Dim strCadenaBillones As Variant, strCadenaMilesMillones As Variant, strCadenaMillones As String, strCadenaMiles As String, strCadenaCientos As String, strCadenaDecimales As String
'....
'falla con 1001,01
'....
    'Dim strBillones As String, strMilesMillones As String, strMillones As String, strMiles As String, strCientos As String
    
    strSeparadorMiles = GetValueCR(15) '"." For Spanish
    strSeparadorDecimales =  GetValueCR(14) '"," For Spanish
    
    If IsMissing(bMoneda) Then bMoneda = False
    If VBA.Len(VBA.CStr(dbValor)) = 1 Then 'Caso unidades
        lgAbsoluto = VBA.Int(dbValor)
    Else
        lgAbsoluto = VBA.CLng(VBA.Mid(dbValor, 1, VBA.InStr(1, dbValor, strSeparadorDecimales) - 1))
    End If
    
    Select Case VBA.Len(VBA.CStr(lgAbsoluto))
        Case Is > 12 'Hay billones
            strCadenaBillones = ConvierteCifra(VBA.Mid(lgAbsoluto, 1, 3))
            strCadenaMilesMillones = ConvierteCifra(VBA.Mid(lgAbsoluto, 4, 3))
            strCadenaMillones = ConvierteCifra(VBA.Mid(lgAbsoluto, 7, 3))
            strCadenaMiles = ConvierteCifra(VBA.Mid(lgAbsoluto, 10, 3))
            strCadenaCientos = ConvierteCifra(VBA.Mid(lgAbsoluto, 13, 3))
        Case Is > 9 'Hay miles de millones
            strCadenaMilesMillones = ConvierteCifra(VBA.Mid(lgAbsoluto, 1, 3))
            strCadenaMillones = ConvierteCifra(VBA.Mid(lgAbsoluto, 4, 3))
            strCadenaMiles = ConvierteCifra(VBA.Mid(lgAbsoluto, 7, 3))
            strCadenaCientos = ConvierteCifra(VBA.Mid(lgAbsoluto, 10, 3))
        Case Is > 6 'Hay millones
            strCadenaMillones = ConvierteCifra(VBA.Mid(lgAbsoluto, 1, 3))
            strCadenaMiles = ConvierteCifra(VBA.Mid(lgAbsoluto, 4, 3))
            strCadenaCientos = ConvierteCifra(VBA.Mid(lgAbsoluto, 7, 3))
        Case Is > 3 'Hay miles
            strCadenaMiles = ConvierteCifra(VBA.Mid(lgAbsoluto, 1, 3))
            strCadenaCientos = ConvierteCifra(VBA.Mid(lgAbsoluto, 4, 3))
        Case Is > 0 'Hay cientos
            strCadenaCientos = ConvierteCifra(VBA.Mid(lgAbsoluto, 1, 3))
    End Select
    
    If dbValor > 999999999999.99 Then
        If VBA.Trim(strCadenaBillones) = "UN" Then
            strCadena = strCadenaBillones & " BILLóN"
        Else
            strCadena = strCadenaBillones & " BILLONES"
        End If
    End If
    
    If dbValor > 999999999.99 Then
        If VBA.Trim(strCadenaMilesMillones) = "UN" Then
            strCadena = strCadena & " MIL"
        Else
            strCadena = strCadena & " " & strCadenaMilesMillones & " MIL"
        End If
    End If
    
    If dbValor > 999999.99 Then
        If VBA.Trim(strCadenaMillones) = "UN" Then
            strCadena = strCadenaMillones & " MILLÓN"
        Else
            strCadena = strCadena & " " & strCadenaMillones & " MILLONES"
        End If
    End If

    If dbValor > 999.99 Then
        If VBA.Trim(strCadenaMiles) = "UN" Then
            strCadena = strCadena & " MIL"
        ElseIf VBA.Trim(strCadenaMiles) = "" Then
            strCadena = strCadena
        Else
            strCadena = strCadena & " " & strCadenaMiles & " MIL"
        End If
    End If
    
    If bMoneda = True Then
        dbDecimales = (dbValor - Abs(Int(dbValor))) * 100
        If Abs(Int(dbValor)) = "0" Then
            strCadena = "CERO EUROS"
        ElseIf Abs(Int(dbValor)) = "1" Then
            strCadena = "UN EURO"
        Else
            strCadena = strCadena & " " & strCadenaCientos & " EUROS"
        End If

        Select Case Round((dbDecimales), 0)
            Case Is = 1 'Un centimo
                strCadena = strCadena & " " & "CON UN CÉNTIMO"
            Case Is > 1 'Hay centimo
                strCadenaDecimales = ConvierteCifra(Round((dbDecimales), 0))
                strCadena = strCadena & " CON " & strCadenaDecimales & " CÉNTIMOS"
        End Select
        
        fALetra = VBA.Trim(strCadena)
        
        If dbValor < 0 Then fALetra = "MENOS " & fALetra
        fALetra = VBA.Replace(fALetra, "  ", " ")
    Else
        'Por mejorar... problemas con sólo una unidad/problemas con más de dos decimales...
        dbDecimales = (dbValor - Abs(Int(dbValor))) * 100
        If Abs(Int(dbValor)) = "0" Then
            strCadena = ""
        ElseIf Abs(Int(dbValor)) = "1" Then
            strCadena = "UNO"
        Else
            strCadena = strCadena & " " & strCadenaCientos
        End If

        Select Case Round((dbDecimales), 0)
            Case Is = 1 'Un centimo
                strCadena = strCadena & " " & "COMA UNO"
            Case Is > 1 'Hay centimo
                strCadenaDecimales = ConvierteCifra(Round((dbDecimales), 0))
                strCadena = strCadena & " COMA " & strCadenaDecimales
        End Select
        
        fALetra = VBA.Trim(strCadena)
        
        If dbValor < 0 Then fALetra = "MENOS " & fALetra
        fALetra = VBA.Replace(fALetra, "  ", " ")
    End If
End Function

Public Function ConvierteCifra(ByVal strCadenaValor As String) As String
    Dim strCentena As String, strDecena As String, strUnidad As String
    Dim txtCentena As String, txtDecena As String, txtUnidad As String
        
    Select Case VBA.Len(strCadenaValor)
        Case 3
            strCentena = VBA.Mid(strCadenaValor, 1, 1)
            strDecena = VBA.Mid(strCadenaValor, 2, 1)
            strUnidad = VBA.Mid(strCadenaValor, 3, 1)
        Case 2
            strDecena = VBA.Mid(strCadenaValor, 1, 1)
            strUnidad = VBA.Mid(strCadenaValor, 2, 1)
        Case 1
            strUnidad = VBA.Mid(strCadenaValor, 1, 1)
    End Select
    
    Select Case strUnidad 'Unidad
        Case 1: txtUnidad = "UN"
        Case 2: txtUnidad = "DOS"
        Case 3: txtUnidad = "TRES"
        Case 4: txtUnidad = "CUATRO"
        Case 5: txtUnidad = "CINCO"
        Case 6: txtUnidad = "SEIS"
        Case 7: txtUnidad = "SIETE"
        Case 8: txtUnidad = "OCHO"
        Case 9: txtUnidad = "NUEVE"
        Case Else: txtUnidad = ""
    End Select

    Select Case strDecena  'Decena
        Case 1: txtDecena = "DIEZ"
            txtUnidad = ""
            Select Case strUnidad
                Case 0: txtDecena = "DIEZ"
                Case 1: txtDecena = "ONCE"
                Case 2: txtDecena = "DOCE"
                Case 3: txtDecena = "TRECE"
                Case 4: txtDecena = "CATORCE"
                Case 5: txtDecena = "QUINCE"
                Case 6: txtDecena = "DIECISEIS"
                Case 7: txtDecena = "DIECISIETE"
                Case 8: txtDecena = "DIECIOCHO"
                Case 9: txtDecena = "DIECINUEVE"
                Case Else: txtDecena = ""
            End Select
        Case 2: txtDecena = "VEINTE": If strUnidad <> "0" Then txtDecena = "VEINTI"
        Case 3: txtDecena = "TREINTA": If strUnidad <> "0" Then txtDecena = "TREINTA Y "
        Case 4: txtDecena = "CUARENTA": If strUnidad <> "0" Then txtDecena = "CUARENTA Y "
        Case 5: txtDecena = "CINCUENTA": If strUnidad <> "0" Then txtDecena = "CINCUENTA Y "
        Case 6: txtDecena = "SESENTA": If strUnidad <> "0" Then txtDecena = "SESENTA Y "
        Case 7: txtDecena = "SETENTA": If strUnidad <> "0" Then txtDecena = "SETENTA Y "
        Case 8: txtDecena = "OCHENTA": If strUnidad <> "0" Then txtDecena = "OCHENTA Y "
        Case 9: txtDecena = "NOVENTA": If strUnidad <> "0" Then txtDecena = "NOVENTA Y "
        Case Else: txtDecena = ""
    End Select
    
    Select Case strCentena 'Centena
        Case 1: ConvierteCifra = "CIEN"
            If CLng(VBA.Mid(strCadenaValor, 2)) > 0 Then ConvierteCifra = "CIENTO"
        Case 2: ConvierteCifra = "DOSCIENTOS"
        Case 3: ConvierteCifra = "TRESCIENTOS"
        Case 4: ConvierteCifra = "CUATROCIENTOS"
        Case 5: ConvierteCifra = "QUINIENTOS"
        Case 6: ConvierteCifra = "SEISCIENTOS"
        Case 7: ConvierteCifra = "SETECIENTOS"
        Case 8: ConvierteCifra = "OCHOCIENTOS"
        Case 9: ConvierteCifra = "NOVECIENTOS"
        Case Else: ConvierteCifra = "" 'Cero o vacío
    End Select

    ConvierteCifra = ConvierteCifra & " " & txtDecena & txtUnidad

End Function

Sorry if part of the function is in spanish, but the VBA code I think is clearly enough.
The function converts numbers to text. Although it is still not complete (for example when 1001,01 it does not recognize that is thousands not hundred of thousands).
I get used to call the functions through the VBA.Whatever format as I've read that this way I can gain some speed in calculation (minimal, I think, but would be perfect if I do the jump to .NET someday). They will work without this too...

I have also to note that the function is language dependant... so I have to use GetLocaleInfo API

Code:

Public Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long

Public Function GetValueCR(sCte As Integer) As String
    Dim sBuffer As String, lBufferLen As Long
    
    lBufferLen = 50
    sBuffer = VBA.Space(lBufferLen)
    If (GetLocaleInfo(LOCALE_USER_DEFAULT, sCte, sBuffer, lBufferLen)) Then
        GetValueCR = VBA.Left(sBuffer, VBA.InStr(sBuffer, VBA.Chr(0)) - 1)
    Else
        GetValueCR = ""
    End If

End Function

Regards.

pgc01 · Mar 19, 2012

I'm sorry, I looked at the code and I don't see why the udf would be called unless the parameters change, which I think is not the case.

The only other possibilities I see are:

- the udf is used in a volatile formula (a formula that contains for ex. Indirect())
- you have some other code that calls a recalculation of the sheet

but I guess you've already checked it.

adulador · Mar 19, 2012

Thank you PGC for your time and ideas.

I'm sure it is not because of volatile, because I only use the function in one cell, and just for test if the function worked (i.e. A1.formula=fAletra(A2;0), and in A2 there is only a number, not any reference).

I wonder if it was a VBA fault or if it only happens to me... seem it is not so common

I will consider the possibility about recalculation of the sheet, thank to point it... uhm, althought I call the

Code:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

generally at the start of all the macros I create, just to gain a little more speed (I should complain to Charles Williams @ Fastexcel for making me write code like this, XDD, will unlink his webpage).

Again, thank you
Kind regards.

adulador · May 12, 2012

OK, I went back to this today, as it make a big mess when I started to use the UDF function more than in one cell.

Code:

Maybe the udf is volatile?

You were RIGHT. Seems I didn't understand too much of the Volatile option.

Here's how the macro ended, just a few modifications later, just if it's for some help for anyone:

Code:

Option Explicit

'APIs to obtain PC configuration
Public Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Public Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Long

Public Const LOCALE_USER_DEFAULT = &H400   'Number Decimal separator Public Const LOCALE_SCURRENCY = &H14        'Local Currency simbol
Public Const LOCALE_SINTLSYMBOL = &H15        'intl monetary simbol
Public Const LOCALE_SMONDECIMALSEP = &H16        'Currency Decimal separator
Public Const LOCALE_SMONTHOUSANDSEP = &H17        'Thousand monetary Separator
Public Const LOCALE_SMONGROUPING = &H18        'List separator
Public Const LOCALE_ICURRDIGITS = &H19        '# Local Currency digits 
Public Function GetValueCR(sCte As Integer) As String
    Dim sBuffer As String, lBufferLen As Long
    
    lBufferLen = 50
    sBuffer = VBA.Space(lBufferLen)
    If (GetLocaleInfo(LOCALE_USER_DEFAULT, sCte, sBuffer, lBufferLen)) Then
        GetValueCR = VBA.Left(sBuffer, VBA.InStr(sBuffer, VBA.Chr(0)) - 1)
    Else
        GetValueCR = ""
    End If

End Function

Sub TestingNumbersToText()
    Dim strStringText As String
    strStringText = fNumbersToText(106.5, "")       'Cells(2, 1).Value)
    VBA.MsgBox strStringText
End Sub

Public Function fNumbersToText(ByRef dbValue As Double, _
                        Optional ByRef strCurrency As String = "EURO", _
                        Optional ByRef strFractionCurrency As String = "CENTS", _
                        Optional ByRef strConcatenator As String = "WITH", _
                        Optional ByRef intDecimals As Integer = 2) As String
    
    Application.Volatile (False)
    Dim strSeparatorThousands As String, strSeparatorDecimals As String
    Dim strAbsolut As String, strDecimals As String
    Dim lgAbsoluto As Long, dbDecimals As Double
    Dim strStringText As String
    Dim Hundreds As Long, Thousands As Long, Millions As Long, ThousandsMillions As Long
    Dim strStringTextBillones As String, strStringTextThousandsMillions As String, strStringTextMillions As String, _
        strStringTextThousands As String, strStringTextHundreds As String, strStringTextDecimals As String
    Dim lgMultiply As Long
    
    strSeparatorThousands = GetValueCR(15)
    strSeparatorDecimals = GetValueCR(14)
    
    If strCurrency = "" Then strCurrency = ""
    If VBA.Len(VBA.CStr(dbValue)) = 1 Then 'Unities
        lgAbsoluto = VBA.Abs(VBA.Fix(dbValue))
    Else
        lgAbsoluto = VBA.Abs(VBA.Fix(dbValue))
    End If
    
    Hundreds = (lgAbsoluto - 1000 * (lgAbsoluto \ 1000))
    Thousands = (lgAbsoluto - 1000000 * (lgAbsoluto \ 1000000)) \ 1000
    Millions = (lgAbsoluto - 1000000000 * (lgAbsoluto \ 1000000000)) \ 1000000
    ThousandsMillions = (lgAbsoluto - Millions * 1000000 - Thousands * 1000 - Hundreds) \ 1000000000
    strStringTextHundreds = fConvertQuantity(Hundreds)
    strStringTextThousands = fConvertQuantity(Thousands)
    strStringTextMillions = fConvertQuantity(Millions)
    strStringTextThousandsMillions = fConvertQuantity(ThousandsMillions)
    
    If VBA.Abs(dbValue) > 999999999999.99 Then
        If VBA.Trim(strStringTextBillones) = "UN" Then
            strStringText = strStringTextBillones & " BILLION"
        Else
            strStringText = strStringTextBillones & " BILLIONS"
        End If
    End If
    
    If VBA.Abs(dbValue) > 999999999.99 Then
        strStringText = VBA.IIf(VBA.Trim(strStringTextThousandsMillions) = "ONE", _
                            strStringText & " THOUSAND", strStringText & " " & strStringTextThousandsMillions & " THOUSANDS")
    End If
    
    If VBA.Abs(dbValue) > 999999.99 Then
        strStringText = VBA.IIf(VBA.Trim(strStringTextMillions) = "ONE", _
                            strStringTextMillions & " MILLION", strStringText & " " & strStringTextMillions & " MILLIONS")
    End If

    If VBA.Abs(dbValue) > 999.99 Then
        If VBA.Trim(strStringTextThousands) = "ONE" Then
            strStringText = strStringText & " THOUSAND"
        ElseIf VBA.Trim(strStringTextThousands) = "" Then
            strStringText = strStringText
        Else
            strStringText = strStringText & " " & strStringTextThousands & " THOUSAND"
        End If
    End If
    
    intDecimals = VBA.IIf(intDecimals > 3, 3, intDecimals)
    lgMultiply = VBA.Val(1 & VBA.String(intDecimals, "0"))
    dbDecimals = (VBA.Abs(dbValue) - VBA.Abs(Fix(dbValue))) * lgMultiply
    If strCurrency <> "" Then
        If VBA.Abs(Int(dbValue)) = "0" Then
            strStringText = "ZERO" & " " & VBA.UCase(strCurrency) & "S"
        ElseIf Abs(Int(dbValue)) = "1" Then
            strStringText = "ONE" & " " & VBA.UCase(strCurrency)
        Else
            strStringText = strStringText & " " & strStringTextHundreds & " " & VBA.UCase(strCurrency) & "S"
        End If

        Select Case VBA.Round((dbDecimals), 0)
            Case Is = 1 'One monetary fraction
                strStringText = strStringText & " " & strConcatenator & " " & "ONE" & " " & strFractionCurrency
            Case Is > 1 'There is monetary fraction
                strStringTextDecimals = fConvertQuantity(VBA.Round((dbDecimals), 0))
                strStringText = strStringText & " " & strConcatenator & " " & strStringTextDecimals & " " & strFractionCurrency & "S"
        End Select
    Else
        If Abs(Int(dbValue)) = "0" Then
            strStringText = ""
        ElseIf Abs(Int(dbValue)) = "1" Then
            strStringText = "ONE"
        Else
            strStringText = strStringText & " " & strStringTextHundreds
        End If

        Select Case VBA.Round((dbDecimals), 0)
            Case Is = 1
                strStringText = strStringText & " " & strConcatenator & " " & " ONE"
            Case Is > 1
                strStringTextDecimals = fConvertQuantity(VBA.Round((dbDecimals), 0))
                strStringText = strStringText & " " & strConcatenator & " " & strStringTextDecimals
        End Select
        
    End If
    
    fNumbersToText = VBA.Trim(strStringText)
    If dbValue < 0 Then fNumbersToText = "MINUS " & fNumbersToText
    fNumbersToText = VBA.Replace(fNumbersToText, "  ", " ")

End Function

Public Function fConvertQuantity(ByVal lgValue As Long) As String
    Dim strHundreds As String, strTens As String, strUnity As String
    Dim matrizUnityes As Variant
    Dim matrizTens As Variant
    Dim matrizTenss As Variant
    Dim matrizTenssY As Variant
    Dim matrizHundreds As Variant

    matrizUnityes = Array("", "ONE", "TWO", "THREE", "FOUR", "FIVE", "SIX", "SEVEN", "EIGHT", "NINE")
    matrizTens = Array("", "ELEVEN", "TWELVE", "THIRTEEN", "FOURTEEN", "FIFTEEN", "SIXTEEN", "SEVENTEEN", "EIGHTEEN", "NINETEEN")
    matrizTenss = Array("", "TEN", "TWENTY", "THIRTY", "FOURTY", "FIFTY", "SIXTY", "SEVENTY", "EIGHTY", "NINETY")
    matrizTenssY = Array("", "", "TWENTY ", "THIRTY ", "FOURTY ", "FIFTY ", "SIXTY ", "SEVENTY ", "EIGHTY ", "NINETY ")
    matrizHundreds = Array("", "ONE HUNDRED", "TWO HUNDREDS", "THREE HUNDREDS", "FOUR HUNDREDS", "FIVE HUNDREDS", _
                          "SIX HUNDREDS", "SEVEN HUNDREDS", "EIGHT HUNDREDS", "NINE HUNDREDS")
    
    Dim Unity As Integer, Tens As Integer, Hundreds As Integer
    Hundreds = lgValue \ 100
    Tens = (lgValue - Hundreds * 100) \ 10
    Unity = (lgValue - Hundreds * 100 - Tens * 10)
    
    strUnity = VBA.IIf(Tens <> 1, matrizUnityes(Unity), matrizTens(Unity))
    
    strTens = VBA.IIf(Tens > 1, matrizTens(Unity), strTens)
    strTens = VBA.IIf(Unity > 0, matrizTenssY(Tens), matrizTenss(Tens))
    
    strHundreds = matrizHundreds(Hundreds)
    fConvertQuantity = strHundreds & " " & strTens & strUnity

End Function

Thank you PGC01

adulador · May 12, 2012

Also, the same function, in spanish language, a bit more complicated... as it depends on the currency gender

.

Code:

Sub Probando()
    Dim strCadena As String
    strCadena = fALetra(106.5, "")       'Cells(2, 1).Value)
    VBA.MsgBox strCadena
End Sub

Public Function fALetra(ByRef dbValor As Double, _
                        Optional ByRef strMoneda As String = "EURO", _
                        Optional ByRef strFraccionMoneda As String = "CÉNTIMO", _
                        Optional ByRef strConcatenador As String = "CON", _
                        Optional ByRef intDecimales As Integer = 2) As String
    
    Application.Volatile (False)
    Dim strSeparadorMiles As String, strSeparadorDecimales As String
    Dim strAbsoluto As String, strDecimales As String
    Dim lgAbsoluto As Long, dbDecimales As Double
    Dim strCadena As String
    Dim Cientos As Long, Miles As Long, Millones As Long, MilesMillones As Long
    Dim strCadenaBillones As String, strCadenaMilesMillones As String, strCadenaMillones As String, _
        strCadenaMiles As String, strCadenaCientos As String, strCadenaDecimales As String
    Dim lgMultiplicador As Long
    
    strSeparadorMiles = GetValueCR(15)
    strSeparadorDecimales = GetValueCR(14)
    
    If strMoneda = "" Then strMoneda = ""
    If VBA.Len(VBA.CStr(dbValor)) = 1 Then 'Caso unidades
        lgAbsoluto = VBA.Abs(VBA.Fix(dbValor))
    Else
        lgAbsoluto = VBA.Abs(VBA.Fix(dbValor))
    End If
    
    Cientos = (lgAbsoluto - 1000 * (lgAbsoluto \ 1000))
    Miles = (lgAbsoluto - 1000000 * (lgAbsoluto \ 1000000)) \ 1000
    Millones = (lgAbsoluto - 1000000000 * (lgAbsoluto \ 1000000000)) \ 1000000
    MilesMillones = (lgAbsoluto - Millones * 1000000 - Miles * 1000 - Cientos) \ 1000000000
    strCadenaCientos = ConvierteCifra(Cientos)
    strCadenaCientos = VBA.IIf(VBA.Right(strCadenaCientos, 2) = "UN" And VBA.UCase(VBA.Right(strMoneda, 1)) = "A", _
                               strCadenaCientos & "A", strCadenaCientos)
    strCadenaCientos = VBA.IIf(VBA.InStr(1, strCadenaCientos, "CIENTOS") > 0 And VBA.UCase(VBA.Right(strMoneda, 1)) = "A", _
                               VBA.Replace(strCadenaCientos, "CIENTOS", "CIENTAS"), strCadenaCientos)
    
    strCadenaMiles = ConvierteCifra(Miles)
    strCadenaMillones = ConvierteCifra(Millones)
    strCadenaMilesMillones = ConvierteCifra(MilesMillones)
    
    If VBA.Abs(dbValor) > 999999999999.99 Then
        If VBA.Trim(strCadenaBillones) = "UN" Then
            strCadena = strCadenaBillones & " BILLóN"
        Else
            strCadena = strCadenaBillones & " BILLONES"
        End If
    End If
    
    If VBA.Abs(dbValor) > 999999999.99 Then
        strCadena = VBA.IIf(VBA.Trim(strCadenaMilesMillones) = "UN", _
                            strCadena & " MIL", strCadena & " " & strCadenaMilesMillones & " MIL")
    End If
    
    If VBA.Abs(dbValor) > 999999.99 Then
        strCadena = VBA.IIf(VBA.Trim(strCadenaMillones) = "UN", _
                            strCadenaMillones & " MILLÓN", strCadena & " " & strCadenaMillones & " MILLONES")
    End If

    If VBA.Abs(dbValor) > 999.99 Then
        If VBA.Trim(strCadenaMiles) = "UN" Then
            strCadena = strCadena & " MIL"
        ElseIf VBA.Trim(strCadenaMiles) = "" Then
            strCadena = strCadena
        Else
            strCadena = strCadena & " " & strCadenaMiles & " MIL"
        End If
    End If
    
    intDecimales = VBA.IIf(intDecimales > 3, 3, intDecimales)
    lgMultiplicador = VBA.Val(1 & VBA.String(intDecimales, "0"))
    dbDecimales = (VBA.Abs(dbValor) - VBA.Abs(Fix(dbValor))) * lgMultiplicador
    If strMoneda <> "" Then
        If VBA.Abs(Int(dbValor)) = "0" Then
            strCadena = "CERO " & VBA.UCase(strMoneda) & "S"
        ElseIf Abs(Int(dbValor)) = "1" Then
            strCadena = VBA.IIf(VBA.UCase(VBA.Right(strMoneda, 1)) = "A", "UNA", "UN")
            strCadena = strCadena & " " & VBA.UCase(strMoneda)
        Else
            strCadena = strCadena & " " & strCadenaCientos & " " & VBA.UCase(strMoneda) & "S"
        End If

        Select Case VBA.Round((dbDecimales), 0)
            Case Is = 1 'Una fracción monetaria
                strCadena = strCadena & " " & strConcatenador & " " & _
                            VBA.IIf(VBA.UCase(VBA.Right(strFraccionMoneda, 1)) = "A", "UNA", "UN") & " " & strFraccionMoneda
            Case Is > 1 'Hay fracción monetaria
                strCadenaDecimales = ConvierteCifra(VBA.Round((dbDecimales), 0))
                strCadenaDecimales = VBA.IIf(VBA.Right(strCadenaDecimales, 2) = "UN" And VBA.UCase(VBA.Right(strFraccionMoneda, 1)) = "A", _
                                             strCadenaDecimales & "A", strCadenaDecimales)
                strCadenaDecimales = VBA.IIf(VBA.InStr(1, strCadenaDecimales, "CIENTOS") > 0 And VBA.UCase(VBA.Right(strMoneda, 1)) = "A", _
                                           VBA.Replace(strCadenaDecimales, "CIENTOS", "CIENTAS"), strCadenaDecimales)
                strCadena = strCadena & " " & strConcatenador & " " & strCadenaDecimales & " " & strFraccionMoneda & "S"
        End Select
    Else
        If Abs(Int(dbValor)) = "0" Then
            strCadena = ""
        ElseIf Abs(Int(dbValor)) = "1" Then
            strCadena = "UNO"
        Else
            strCadena = strCadena & " " & strCadenaCientos
        End If

        Select Case VBA.Round((dbDecimales), 0)
            Case Is = 1
                strCadena = strCadena & " " & strConcatenador & " " & " UNO"
            Case Is > 1
                strCadenaDecimales = ConvierteCifra(VBA.Round((dbDecimales), 0))
                strCadena = strCadena & " " & strConcatenador & " " & strCadenaDecimales
        End Select
        
    End If
    
    fALetra = VBA.Trim(strCadena)
    If dbValor < 0 Then fALetra = "MENOS " & fALetra
    fALetra = VBA.Replace(fALetra, "  ", " ")

End Function

Public Function ConvierteCifra(ByVal lgValor As Long) As String
    Dim strCentena As String, strDecena As String, strUnidad As String
    Dim matrizUnidades As Variant
    Dim matrizDecena As Variant
    Dim matrizDecenas As Variant
    Dim matrizDecenasY As Variant
    Dim matrizCentena As Variant

    matrizUnidades = Array("", "UN", "DOS", "TRES", "CUATRO", "CINCO", "SEIS", "SIETE", "OCHO", "NUEVE")
    matrizDecena = Array("", "ONCE", "DOCE", "TRECE", "CATORCE", "QUINCE", "DIECISEIS", "DIECISIETE", "DIECIOCHO", "DIECINUEVE")
    matrizDecenas = Array("", "DIEZ", "VEINTE", "TREINTA", "CUARENTA", "CINCUENTA", "SESENTA", "SETENTA", "OCHENTA", "NOVENTA")
    matrizDecenasY = Array("", "", "VEINTI", "TREINTA Y ", "CUARENTA Y ", "CINCUENTA Y ", _
                           "SESENTA Y ", "SETENTA Y ", "OCHENTA Y ", "NOVENTA Y ")
    matrizCentena = Array("", "", "DOSCIENTOS", "TRESCIENTOS", "CUATROCIENTOS", "QUINIENTOS", _
                          "SEISCIENTOS", "SETECIENTOS", "OCHOCIENTOS", "NOVECIENTOS")
    
    Dim Unidad As Integer, Decena As Integer, Centena As Integer
    Centena = lgValor \ 100
    Decena = (lgValor - Centena * 100) \ 10
    Unidad = (lgValor - Centena * 100 - Decena * 10)
    
    strUnidad = VBA.IIf(Decena <> 1, matrizUnidades(Unidad), matrizDecena(Unidad))
    
    strDecena = VBA.IIf(Decena > 1, matrizDecena(Unidad), strDecena)
    strDecena = VBA.IIf(Unidad > 0, matrizDecenasY(Decena), matrizDecenas(Decena))
    
    strCentena = VBA.IIf(Centena = 1, "CIEN", matrizCentena(Centena))
    strCentena = VBA.IIf(Centena = 1 And (Decena + Unidad > 0), "CIENTO", matrizCentena(Centena))
    ConvierteCifra = strCentena & " " & strDecena & strUnidad

End Function
 
'En idioma inglés...
Public Function fNumbersToText(ByRef dbValue As Double, _
                        Optional ByRef strCurrency As String = "EURO", _
                        Optional ByRef strFractionCurrency As String = "CENTS", _
                        Optional ByRef strConcatenator As String = "WITH", _
                        Optional ByRef intDecimals As Integer = 2) As String
    
    Application.Volatile (False)
    Dim strSeparatorThousands As String, strSeparatorDecimals As String
    Dim strAbsolut As String, strDecimals As String
    Dim lgAbsoluto As Long, dbDecimals As Double
    Dim strStringText As String
    Dim Hundreds As Long, Thousands As Long, Millions As Long, ThousandsMillions As Long
    Dim strStringTextBillones As String, strStringTextThousandsMillions As String, strStringTextMillions As String, _
        strStringTextThousands As String, strStringTextHundreds As String, strStringTextDecimals As String
    Dim lgMultiply As Long
    
    strSeparatorThousands = GetValueCR(15)
    strSeparatorDecimals = GetValueCR(14)
    
    If strCurrency = "" Then strCurrency = ""
    If VBA.Len(VBA.CStr(dbValue)) = 1 Then 'Unities
        lgAbsoluto = VBA.Abs(VBA.Fix(dbValue))
    Else
        lgAbsoluto = VBA.Abs(VBA.Fix(dbValue))
    End If
    
    Hundreds = (lgAbsoluto - 1000 * (lgAbsoluto \ 1000))
    Thousands = (lgAbsoluto - 1000000 * (lgAbsoluto \ 1000000)) \ 1000
    Millions = (lgAbsoluto - 1000000000 * (lgAbsoluto \ 1000000000)) \ 1000000
    ThousandsMillions = (lgAbsoluto - Millions * 1000000 - Thousands * 1000 - Hundreds) \ 1000000000
    strStringTextHundreds = fConvertQuantity(Hundreds)
    strStringTextThousands = fConvertQuantity(Thousands)
    strStringTextMillions = fConvertQuantity(Millions)
    strStringTextThousandsMillions = fConvertQuantity(ThousandsMillions)
    
    If VBA.Abs(dbValue) > 999999999999.99 Then
        If VBA.Trim(strStringTextBillones) = "UN" Then
            strStringText = strStringTextBillones & " BILLION"
        Else
            strStringText = strStringTextBillones & " BILLIONS"
        End If
    End If
    
    If VBA.Abs(dbValue) > 999999999.99 Then
        strStringText = VBA.IIf(VBA.Trim(strStringTextThousandsMillions) = "ONE", _
                            strStringText & " THOUSAND", strStringText & " " & strStringTextThousandsMillions & " THOUSANDS")
    End If
    
    If VBA.Abs(dbValue) > 999999.99 Then
        strStringText = VBA.IIf(VBA.Trim(strStringTextMillions) = "ONE", _
                            strStringTextMillions & " MILLION", strStringText & " " & strStringTextMillions & " MILLIONS")
    End If

    If VBA.Abs(dbValue) > 999.99 Then
        If VBA.Trim(strStringTextThousands) = "ONE" Then
            strStringText = strStringText & " THOUSAND"
        ElseIf VBA.Trim(strStringTextThousands) = "" Then
            strStringText = strStringText
        Else
            strStringText = strStringText & " " & strStringTextThousands & " THOUSAND"
        End If
    End If
    
    intDecimals = VBA.IIf(intDecimals > 3, 3, intDecimals)
    lgMultiply = VBA.Val(1 & VBA.String(intDecimals, "0"))
    dbDecimals = (VBA.Abs(dbValue) - VBA.Abs(Fix(dbValue))) * lgMultiply
    If strCurrency <> "" Then
        If VBA.Abs(Int(dbValue)) = "0" Then
            strStringText = "ZERO" & " " & VBA.UCase(strCurrency) & "S"
        ElseIf Abs(Int(dbValue)) = "1" Then
            strStringText = "ONE" & " " & VBA.UCase(strCurrency)
        Else
            strStringText = strStringText & " " & strStringTextHundreds & " " & VBA.UCase(strCurrency) & "S"
        End If

        Select Case VBA.Round((dbDecimals), 0)
            Case Is = 1 'One monetary fraction
                strStringText = strStringText & " " & strConcatenator & " " & "ONE" & " " & strFractionCurrency
            Case Is > 1 'There is monetary fraction
                strStringTextDecimals = fConvertQuantity(VBA.Round((dbDecimals), 0))
                strStringText = strStringText & " " & strConcatenator & " " & strStringTextDecimals & " " & strFractionCurrency & "S"
        End Select
    Else
        If Abs(Int(dbValue)) = "0" Then
            strStringText = ""
        ElseIf Abs(Int(dbValue)) = "1" Then
            strStringText = "ONE"
        Else
            strStringText = strStringText & " " & strStringTextHundreds
        End If

        Select Case VBA.Round((dbDecimals), 0)
            Case Is = 1
                strStringText = strStringText & " " & strConcatenator & " " & " ONE"
            Case Is > 1
                strStringTextDecimals = fConvertQuantity(VBA.Round((dbDecimals), 0))
                strStringText = strStringText & " " & strConcatenator & " " & strStringTextDecimals
        End Select
        
    End If
    
    fNumbersToText = VBA.Trim(strStringText)
    If dbValue < 0 Then fNumbersToText = "MINUS " & fNumbersToText
    fNumbersToText = VBA.Replace(fNumbersToText, "  ", " ")

End Function

Public Function fConvertQuantity(ByVal lgValue As Long) As String
    Dim strHundreds As String, strTens As String, strUnity As String
    Dim matrizUnityes As Variant
    Dim matrizTens As Variant
    Dim matrizTenss As Variant
    Dim matrizTenssY As Variant
    Dim matrizHundreds As Variant

    matrizUnityes = Array("", "ONE", "TWO", "THREE", "FOUR", "FIVE", "SIX", "SEVEN", "EIGHT", "NINE")
    matrizTens = Array("", "ELEVEN", "TWELVE", "THIRTEEN", "FOURTEEN", "FIFTEEN", "SIXTEEN", "SEVENTEEN", "EIGHTEEN", "NINETEEN")
    matrizTenss = Array("", "TEN", "TWENTY", "THIRTY", "FOURTY", "FIFTY", "SIXTY", "SEVENTY", "EIGHTY", "NINETY")
    matrizTenssY = Array("", "", "TWENTY ", "THIRTY ", "FOURTY ", "FIFTY ", "SIXTY ", "SEVENTY ", "EIGHTY ", "NINETY ")
    matrizHundreds = Array("", "ONE HUNDRED", "TWO HUNDREDS", "THREE HUNDREDS", "FOUR HUNDREDS", "FIVE HUNDREDS", _
                          "SIX HUNDREDS", "SEVEN HUNDREDS", "EIGHT HUNDREDS", "NINE HUNDREDS")
    
    Dim Unity As Integer, Tens As Integer, Hundreds As Integer
    Hundreds = lgValue \ 100
    Tens = (lgValue - Hundreds * 100) \ 10
    Unity = (lgValue - Hundreds * 100 - Tens * 10)
    
    strUnity = VBA.IIf(Tens <> 1, matrizUnityes(Unity), matrizTens(Unity))
    
    strTens = VBA.IIf(Tens > 1, matrizTens(Unity), strTens)
    strTens = VBA.IIf(Unity > 0, matrizTenssY(Tens), matrizTenss(Tens))
    
    strHundreds = matrizHundreds(Hundreds)
    fConvertQuantity = strHundreds & " " & strTens & strUnity

End Function

ZVI · May 13, 2012

More possible reasons:
1. Precedent cells are modified. For example, changing A2 (via macro) for the formula =fAletra(A2;0) forces fAletra UDF call, even at Application.Calculation = xlCalculationManual
2. If autofilter is applied (via macro) to the rows with UDF then that UDF recalculates. To avoid this use Application.EnableEvents = False/True on Top/Bottom line of the macro

There can be also UDF in names RefersTo formulas – check it too.

adulador · May 13, 2012

ZVI thanks for your tips. I'll have a look.

A few more adjustments: for the english version of the UDF -which I made in a fast sight just to post here, so I "FAILED" in my first try

-... Billions were expressed as in spanish (Billion = 1 million x 1 million), not the english (1 billion = 1 thousand x 1 million). So there, Billion = Trillion

... and now in the spanish's have added Milliards to express the english equivalent to Billion (to follow the dictates of the Royal Academy of the Spanish Language):

So this is final version with ZVI tip:

Code:

Public Function fNumbersToText(ByRef dbValue As Double, _
                        Optional ByRef strCurrency As String = "EURO", _
                        Optional ByRef strFractionCurrency As String = "CENTS", _
                        Optional ByRef strConcatenator As String = "WITH", _
                        Optional ByRef intDecimals As Integer = 2) As String
    
    Application.Volatile (False)

    Dim strAbsolut As String, strDecimals As String
    Dim lgAbsolut As Long, dbDecimals As Double
    Dim strStringText As String, strFinalString As String
    Dim Hundreds As Long, Thousands As Long, Millions As Long, Billions As Long
    Dim strStringTextBillones As String, strStringTextBillions As String, strStringTextMillions As String, _
        strStringTextThousands As String, strStringTextHundreds As String, strStringTextDecimals As String
    Dim lgMultiply As Long
    
    If strCurrency = "" Then strCurrency = ""
    If VBA.Len(VBA.CStr(dbValue)) = 1 Then 'Unities
        lgAbsolut = VBA.Abs(VBA.Fix(dbValue))
    Else
        lgAbsolut = VBA.Abs(VBA.Fix(dbValue))
    End If
    
    Hundreds = (lgAbsolut - 1000 * (lgAbsolut \ 1000))
    Thousands = (lgAbsolut - 1000000 * (lgAbsolut \ 1000000)) \ 1000
    Millions = (lgAbsolut - 1000000000 * (lgAbsolut \ 1000000000)) \ 1000000
    Billions = (lgAbsolut - Millions * 1000000 - Thousands * 1000 - Hundreds) \ 1000000000
    strStringTextHundreds = fConvertQuantity(Hundreds)
    strStringTextThousands = fConvertQuantity(Thousands)
    strStringTextMillions = fConvertQuantity(Millions)
    strStringTextBillions = fConvertQuantity(Billions)
    
    If VBA.Abs(dbValue) > 999999999999.99 Then
        If VBA.Trim(strStringTextBillones) = "UN" Then
            strStringText = strStringTextBillones & " TRILLION"
        Else
            strStringText = strStringTextBillones & " TRILLIONS"
        End If
    End If
    
    If VBA.Abs(dbValue) > 999999999.99 Then
        strStringText = VBA.IIf(VBA.Trim(strStringTextBillions) = "ONE", _
                            strStringText & " BILLION", strStringText & " " & strStringTextBillions & " BILLIONS")
    End If
    
    If VBA.Abs(dbValue) > 999999.99 Then
        strStringText = VBA.IIf(VBA.Trim(strStringTextMillions) = "ONE", _
                            strStringTextMillions & " MILLION", strStringText & " " & strStringTextMillions & " MILLIONS")
    End If

    If VBA.Abs(dbValue) > 999.99 Then
        If VBA.Trim(strStringTextThousands) = "ONE" Then
            strStringText = strStringText & " THOUSAND"
        ElseIf VBA.Trim(strStringTextThousands) = "" Then
            strStringText = strStringText
        Else
            strStringText = strStringText & " " & strStringTextThousands & " THOUSAND"
        End If
    End If
    
    intDecimals = VBA.IIf(intDecimals > 3, 3, intDecimals)
    lgMultiply = VBA.Val(1 & VBA.String(intDecimals, "0"))
    dbDecimals = (VBA.Abs(dbValue) - VBA.Abs(Fix(dbValue))) * lgMultiply
    If strCurrency <> "" Then
        If VBA.Abs(Int(dbValue)) = "0" Then
            strStringText = "ZERO" & " " & VBA.UCase(strCurrency) & "S"
        ElseIf Abs(Int(dbValue)) = "1" Then
            strStringText = "ONE" & " " & VBA.UCase(strCurrency)
        Else
            strStringText = strStringText & " " & strStringTextHundreds & " " & VBA.UCase(strCurrency) & "S"
        End If

        Select Case VBA.Round((dbDecimals), 0)
            Case Is = 1 'One monetary fraction
                strStringText = strStringText & " " & strConcatenator & " " & "ONE" & " " & strFractionCurrency
            Case Is > 1 'More than one monetary fraction
                strStringTextDecimals = fConvertQuantity(VBA.Round((dbDecimals), 0))
                strStringText = strStringText & " " & strConcatenator & " " & strStringTextDecimals & " " & strFractionCurrency & "S"
        End Select
    Else
        If Abs(Int(dbValue)) = "0" Then
            strStringText = ""
        ElseIf Abs(Int(dbValue)) = "1" Then
            strStringText = "ONE"
        Else
            strStringText = strStringText & " " & strStringTextHundreds
        End If

        Select Case VBA.Round((dbDecimals), 0)
            Case Is = 1
                strStringText = strStringText & " " & strConcatenator & " " & " ONE"
            Case Is > 1
                strStringTextDecimals = fConvertQuantity(VBA.Round((dbDecimals), 0))
                strStringText = strStringText & " " & strConcatenator & " " & strStringTextDecimals
        End Select
        
    End If
    
    strFinalString = VBA.Trim(strStringText)
    If dbValue < 0 Then strFinalString = "MINUS " & strFinalString
    fNumbersToText = VBA.Replace(strFinalString, "  ", " ")

End Function

Public Function fConvertQuantity(ByVal lgValue As Long) As String
    Dim strHundreds As String, strTens As String, strUnity As String
    Dim matrizUnityes As Variant
    Dim matrizTens As Variant
    Dim matrizTenss As Variant
    Dim matrizTenssY As Variant
    Dim matrizHundreds As Variant

    matrizUnityes = Array("", "ONE", "TWO", "THREE", "FOUR", "FIVE", "SIX", "SEVEN", "EIGHT", "NINE")
    matrizTens = Array("", "ELEVEN", "TWELVE", "THIRTEEN", "FOURTEEN", "FIFTEEN", "SIXTEEN", "SEVENTEEN", "EIGHTEEN", "NINETEEN")
    matrizTenss = Array("", "TEN", "TWENTY", "THIRTY", "FOURTY", "FIFTY", "SIXTY", "SEVENTY", "EIGHTY", "NINETY")
    matrizTenssY = Array("", "", "TWENTY ", "THIRTY ", "FOURTY ", "FIFTY ", "SIXTY ", "SEVENTY ", "EIGHTY ", "NINETY ")
    matrizHundreds = Array("", "ONE HUNDRED", "TWO HUNDREDS", "THREE HUNDREDS", "FOUR HUNDREDS", "FIVE HUNDREDS", _
                          "SIX HUNDREDS", "SEVEN HUNDREDS", "EIGHT HUNDREDS", "NINE HUNDREDS")
    
    Dim Unity As Integer, Tens As Integer, Hundreds As Integer
    Hundreds = lgValue \ 100
    Tens = (lgValue - Hundreds * 100) \ 10
    Unity = (lgValue - Hundreds * 100 - Tens * 10)
    
    strUnity = VBA.IIf(Tens <> 1, matrizUnityes(Unity), matrizTens(Unity))
    
    strTens = VBA.IIf(Tens > 1, matrizTens(Unity), strTens)
    strTens = VBA.IIf(Unity > 0, matrizTenssY(Tens), matrizTenss(Tens))
    
    strHundreds = matrizHundreds(Hundreds)
    fConvertQuantity = strHundreds & " " & strTens & strUnity

End Function

'The Spanish UDF:
Public Function fALetra(ByRef dbValor As Double, _
                        Optional ByRef strMoneda As String = "EURO", _
                        Optional ByRef strFraccionMoneda As String = "CÉNTIMO", _
                        Optional ByRef strConcatenador As String = "CON", _
                        Optional ByRef intDecimales As Integer = 2) As String
    
    Application.Volatile (False)
    Dim strSeparadorMiles As String, strSeparadorDecimales As String
    Dim strAbsoluto As String, strDecimales As String
    Dim lgAbsoluto As Long, dbDecimales As Double
    Dim strCadena As String, strCadenaFinal as String
    Dim Cientos As Long, Miles As Long, Millones As Long, Millardos As Long
    Dim strCadenaBillones As String, strCadenaMillardos As String, strCadenaMillones As String, _
        strCadenaMiles As String, strCadenaCientos As String, strCadenaDecimales As String
    Dim lgMultiplicador As Long
    
    'Si se leen números (procedentes de fuentes externas) que no se corresponden con la configuración numérica del usuario
    'strSeparadorMiles = GetValueCR(15)
    'strSeparadorDecimales = GetValueCR(14)
    '

    If strMoneda = "" Then strMoneda = ""
    If VBA.Len(VBA.CStr(dbValor)) = 1 Then 'Caso unidades
        lgAbsoluto = VBA.Abs(VBA.Fix(dbValor))
    Else
        lgAbsoluto = VBA.Abs(VBA.Fix(dbValor))
    End If
    
    Cientos = (lgAbsoluto - 1000 * (lgAbsoluto \ 1000))
    Miles = (lgAbsoluto - 1000000 * (lgAbsoluto \ 1000000)) \ 1000
    Millones = (lgAbsoluto - 1000000000 * (lgAbsoluto \ 1000000000)) \ 1000000
    Millardos = (lgAbsoluto - Millones * 1000000 - Miles * 1000 - Cientos) \ 1000000000
    strCadenaCientos = ConvierteCifra(Cientos)
    strCadenaCientos = VBA.IIf(VBA.Right(strCadenaCientos, 2) = "UN" And VBA.UCase(VBA.Right(strMoneda, 1)) = "A", _
                               strCadenaCientos & "A", strCadenaCientos)
    strCadenaCientos = VBA.IIf(VBA.InStr(1, strCadenaCientos, "CIENTOS") > 0 And VBA.UCase(VBA.Right(strMoneda, 1)) = "A", _
                               VBA.Replace(strCadenaCientos, "CIENTOS", "CIENTAS"), strCadenaCientos)
    
    strCadenaMiles = ConvierteCifra(Miles)
    strCadenaMillones = ConvierteCifra(Millones)
    strCadenaMillardos = ConvierteCifra(Millardos)
    
    If VBA.Abs(dbValor) > 999999999999.99 Then
        If VBA.Trim(strCadenaBillones) = "UN" Then
            strCadena = strCadenaBillones & " BILLóN"
        Else
            strCadena = strCadenaBillones & " BILLONES"
        End If
    End If
    
    If VBA.Abs(dbValor) > 999999999.99 Then
        strCadena = VBA.IIf(VBA.Trim(strCadenaMillardos) = "UN", _
                            strCadena & " MILLARDO", strCadena & " " & strCadenaMillardos & " MILLARDOS")
    End If
    
    If VBA.Abs(dbValor) > 999999.99 Then
        strCadena = VBA.IIf(VBA.Trim(strCadenaMillones) = "UN", _
                            strCadenaMillones & " MILLÓN", strCadena & " " & strCadenaMillones & " MILLONES")
    End If

    If VBA.Abs(dbValor) > 999.99 Then
        If VBA.Trim(strCadenaMiles) = "UN" Then
            strCadena = strCadena & " MIL"
        ElseIf VBA.Trim(strCadenaMiles) = "" Then
            strCadena = strCadena
        Else
            strCadena = strCadena & " " & strCadenaMiles & " MIL"
        End If
    End If
    
    intDecimales = VBA.IIf(intDecimales > 3, 3, intDecimales)
    lgMultiplicador = VBA.Val(1 & VBA.String(intDecimales, "0"))
    dbDecimales = (VBA.Abs(dbValor) - VBA.Abs(Fix(dbValor))) * lgMultiplicador
    If strMoneda <> "" Then
        If VBA.Abs(Int(dbValor)) = "0" Then
            strCadena = "CERO " & VBA.UCase(strMoneda) & "S"
        ElseIf Abs(Int(dbValor)) = "1" Then
            strCadena = VBA.IIf(VBA.UCase(VBA.Right(strMoneda, 1)) = "A", "UNA", "UN")
            strCadena = strCadena & " " & VBA.UCase(strMoneda)
        Else
            strCadena = strCadena & " " & strCadenaCientos & " " & VBA.UCase(strMoneda) & "S"
        End If

        Select Case VBA.Round((dbDecimales), 0)
            Case Is = 1 'Una fracción monetaria
                strCadena = strCadena & " " & strConcatenador & " " & _
                            VBA.IIf(VBA.UCase(VBA.Right(strFraccionMoneda, 1)) = "A", "UNA", "UN") & " " & strFraccionMoneda
            Case Is > 1 'Hay fracción monetaria
                strCadenaDecimales = ConvierteCifra(VBA.Round((dbDecimales), 0))
                strCadenaDecimales = VBA.IIf(VBA.Right(strCadenaDecimales, 2) = "UN" And VBA.UCase(VBA.Right(strFraccionMoneda, 1)) = "A", _
                                             strCadenaDecimales & "A", strCadenaDecimales)
                strCadenaDecimales = VBA.IIf(VBA.InStr(1, strCadenaDecimales, "CIENTOS") > 0 And VBA.UCase(VBA.Right(strMoneda, 1)) = "A", _
                                           VBA.Replace(strCadenaDecimales, "CIENTOS", "CIENTAS"), strCadenaDecimales)
                strCadena = strCadena & " " & strConcatenador & " " & strCadenaDecimales & " " & strFraccionMoneda & "S"
        End Select
    Else
        If Abs(Int(dbValor)) = "0" Then
            strCadena = ""
        ElseIf Abs(Int(dbValor)) = "1" Then
            strCadena = "UNO"
        Else
            strCadena = strCadena & " " & strCadenaCientos
        End If

        Select Case VBA.Round((dbDecimales), 0)
            Case Is = 1
                strCadena = strCadena & " " & strConcatenador & " " & " UNO"
            Case Is > 1
                strCadenaDecimales = ConvierteCifra(VBA.Round((dbDecimales), 0))
                strCadena = strCadena & " " & strConcatenador & " " & strCadenaDecimales
        End Select
        
    End If
    
    strCadenaFinal = VBA.Trim(strCadena)
    If dbValor < 0 Then strCadenaFinal = "MENOS " & strCadenaFinal
    fALetra = VBA.Replace(strCadenaFinal, "  ", " ")

End Function

Public Function ConvierteCifra(ByVal lgValor As Long) As String
    Dim strCentena As String, strDecena As String, strUnidad As String
    Dim matrizUnidades As Variant
    Dim matrizDecena As Variant
    Dim matrizDecenas As Variant
    Dim matrizDecenasY As Variant
    Dim matrizCentena As Variant

    matrizUnidades = Array("", "UN", "DOS", "TRES", "CUATRO", "CINCO", "SEIS", "SIETE", "OCHO", "NUEVE")
    matrizDecena = Array("", "ONCE", "DOCE", "TRECE", "CATORCE", "QUINCE", "DIECISEIS", "DIECISIETE", "DIECIOCHO", "DIECINUEVE")
    matrizDecenas = Array("", "DIEZ", "VEINTE", "TREINTA", "CUARENTA", "CINCUENTA", "SESENTA", "SETENTA", "OCHENTA", "NOVENTA")
    matrizDecenasY = Array("", "", "VEINTI", "TREINTA Y ", "CUARENTA Y ", "CINCUENTA Y ", _
                           "SESENTA Y ", "SETENTA Y ", "OCHENTA Y ", "NOVENTA Y ")
    matrizCentena = Array("", "", "DOSCIENTOS", "TRESCIENTOS", "CUATROCIENTOS", "QUINIENTOS", _
                          "SEISCIENTOS", "SETECIENTOS", "OCHOCIENTOS", "NOVECIENTOS")
    
    Dim Unidad As Integer, Decena As Integer, Centena As Integer
    Centena = lgValor \ 100
    Decena = (lgValor - Centena * 100) \ 10
    Unidad = (lgValor - Centena * 100 - Decena * 10)
    
    strUnidad = VBA.IIf(Decena <> 1, matrizUnidades(Unidad), matrizDecena(Unidad))
    
    strDecena = VBA.IIf(Decena > 1, matrizDecena(Unidad), strDecena)
    strDecena = VBA.IIf(Unidad > 0, matrizDecenasY(Decena), matrizDecenas(Decena))
    
    strCentena = VBA.IIf(Centena = 1, "CIEN", matrizCentena(Centena))
    strCentena = VBA.IIf(Centena = 1 And (Decena + Unidad > 0), "CIENTO", matrizCentena(Centena))
    ConvierteCifra = strCentena & " " & strDecena & strUnidad

End Function

adulador · May 13, 2012

A (hope definitive) whole revision... with correct Gender handling, and Decimals up to 11
UDF separated and only called once.

Code:

Option Explicit

Sub Probando()
    Dim strCadena As String
    strCadena = fALetra(106.5, "")       'Cells(2, 1).Value)
    VBA.MsgBox strCadena
End Sub

Public Function fALetra(ByRef dbValor As Double, _
                        Optional ByRef strMoneda As String = "EURO", _
                        Optional ByRef strFraccionMoneda As String = "CÉNTIMO", _
                        Optional ByRef strConcatenador As String = "CON", _
                        Optional ByRef intDecimales As Integer = 2) As String
    
    Application.Volatile (False)
    Dim strSeparadorMiles As String, strSeparadorDecimales As String
    Dim strAbsoluto As String, strDecimales As String
    Dim lgAbsoluto As Long, lgParteDecimal As Long
    Dim strCadena As String, strCadenaDecimal As String, strCadenaFinal As String
    Dim lgMultiplicador As Long
    
    'Si se leen números (procedentes de fuentes externas) que no se corresponden con la configuración numérica del usuario
    'strSeparadorMiles = GetValueCR(15)
    'strSeparadorDecimales = GetValueCR(14)
    '

    If VBA.Abs(dbValor) >= 10000000000# Then fALetra = "#Supera el límite#": Exit Function
    
    If strMoneda = "" Then strMoneda = ""
    lgAbsoluto = VBA.Abs(VBA.Fix(dbValor))
    
    strCadena = fConvierteEntero(lgAbsoluto, strMoneda)

    lgMultiplicador = VBA.Val(1 & VBA.String(intDecimales, "0"))
    lgParteDecimal = VBA.CInt((VBA.Abs(dbValor) - VBA.Abs(Fix(dbValor))) * lgMultiplicador)
    strCadenaDecimal = fConvierteEntero(lgParteDecimal, strFraccionMoneda)

    strCadenaFinal = VBA.Trim(strCadena & " " & strConcatenador & " " & strCadenaDecimal)
    If dbValor < 0 Then strCadenaFinal = "MENOS " & strCadenaFinal
    Do Until VBA.InStr(1, strCadenaFinal, "  ") = 0
        strCadenaFinal = VBA.Replace(strCadenaFinal, "  ", " ")
    Loop
    fALetra = strCadenaFinal

End Function

Public Function fConvierteEntero(ByVal lgAbsoluto As Long, ByRef strMoneda As String) As String
    
    Dim Cientos As Long, Miles As Long, Millones As Long, Millardos As Long
    Dim strCadenaBillones As String, strCadenaMillardos As String, strCadenaMillones As String, _
        strCadenaMiles As String, strCadenaCientos As String, strCadenaDecimales As String
    Dim strCadena As String, strCadenaFinal As String
    
    Cientos = (lgAbsoluto - 1000 * (lgAbsoluto \ 1000))
    Miles = (lgAbsoluto - 1000000 * (lgAbsoluto \ 1000000)) \ 1000
    Millones = (lgAbsoluto - 1000000000 * (lgAbsoluto \ 1000000000)) \ 1000000
    Millardos = (lgAbsoluto - Millones * 1000000 - Miles * 1000 - Cientos) \ 1000000000
    strCadenaCientos = ConvierteCifra(Cientos)
    strCadenaMiles = ConvierteCifra(Miles)
    strCadenaMillones = ConvierteCifra(Millones)
    strCadenaMillardos = ConvierteCifra(Millardos)
                        
    If lgAbsoluto = "0" Then
        strCadenaCientos = VBA.IIf(strMoneda <> "", "CERO ", "")
    ElseIf lgAbsoluto = "1" Then
        strCadenaCientos = "UN "
    Else
        strCadenaCientos = strCadenaCientos & " "
    End If
    
    If lgAbsoluto >= 1000 Then
        If VBA.Trim(strCadenaMiles) = "UN" Then
            strCadena = strCadena & " MIL"
        ElseIf VBA.Trim(strCadenaMiles) = "" Then
            strCadena = strCadena
        Else
            strCadena = strCadenaMiles & " MIL"
        End If
    End If

    strCadena = strCadena & " " & strCadenaCientos
    
    If strMoneda <> "" Then
        strCadena = VBA.IIf(VBA.UCase(VBA.Right(strMoneda, 1)) = "A", VBA.Replace(strCadena, "UN ", "UNA "), strCadena)
        strCadena = VBA.Replace(strCadena, "CIENTOS", "CIENTAS")
        strCadena = strCadena & VBA.IIf(lgAbsoluto <> 1, " " & VBA.UCase(strMoneda) & "S", " " & VBA.UCase(strMoneda))
    Else
        strCadena = VBA.Replace(strCadena, "UN ", "UNO ")
    End If
    
    If lgAbsoluto >= 1000000 Then
        strCadena = VBA.IIf(VBA.Trim(strCadenaMillones) = "UN", strCadenaMillones & " MILLÓN ", strCadenaMillones & " MILLONES ") & _
                    strCadena
    End If
    
    If lgAbsoluto >= 1000000000 Then
        strCadena = VBA.IIf(VBA.Trim(strCadenaMillardos) = "UN", strCadenaMillardos & " MILLARDO ", strCadenaMillardos & " MILLARDOS ") & _
                    strCadena
    End If

    'If VBA.Abs(dbValor) >= 1000000000000# Then
    '    strCadena = VBA.IIf(VBA.Trim(strCadenaMillardos) = "UN", strCadenaMillardos & " BILLÓN ", strCadenaMillardos & " BILLONES ") & _
    '                strCadena
    'End If

    fConvierteEntero = strCadena
    
End Function

Public Function ConvierteCifra(ByVal lgValor As Long) As String
    Dim strCentena As String, strDecena As String, strUnidad As String
    Dim matrizUnidades As Variant
    Dim matrizDecena As Variant
    Dim matrizDecenas As Variant
    Dim matrizDecenasY As Variant
    Dim matrizCentena As Variant

    matrizUnidades = Array("", "UN", "DOS", "TRES", "CUATRO", "CINCO", "SEIS", "SIETE", "OCHO", "NUEVE")
    matrizDecena = Array("", "ONCE", "DOCE", "TRECE", "CATORCE", "QUINCE", "DIECISEIS", "DIECISIETE", "DIECIOCHO", "DIECINUEVE")
    matrizDecenas = Array("", "DIEZ", "VEINTE", "TREINTA", "CUARENTA", "CINCUENTA", "SESENTA", "SETENTA", "OCHENTA", "NOVENTA")
    matrizDecenasY = Array("", "", "VEINTI", "TREINTA Y ", "CUARENTA Y ", "CINCUENTA Y ", _
                           "SESENTA Y ", "SETENTA Y ", "OCHENTA Y ", "NOVENTA Y ")
    matrizCentena = Array("", "", "DOSCIENTOS", "TRESCIENTOS", "CUATROCIENTOS", "QUINIENTOS", _
                          "SEISCIENTOS", "SETECIENTOS", "OCHOCIENTOS", "NOVECIENTOS")
    
    Dim Unidad As Integer, Decena As Integer, Centena As Integer
    Centena = lgValor \ 100
    Decena = (lgValor - Centena * 100) \ 10
    Unidad = (lgValor - Centena * 100 - Decena * 10)
    
    strUnidad = VBA.IIf(Decena <> 1, matrizUnidades(Unidad), matrizDecena(Unidad))
    
    strDecena = VBA.IIf(Decena > 1, matrizDecena(Unidad), strDecena)
    strDecena = VBA.IIf(Unidad > 0, matrizDecenasY(Decena), matrizDecenas(Decena))
    
    strCentena = VBA.IIf(Centena = 1, "CIEN", matrizCentena(Centena))
    strCentena = VBA.IIf(Centena = 1 And (Decena + Unidad > 0), "CIENTO", matrizCentena(Centena))
    ConvierteCifra = strCentena & " " & strDecena & strUnidad

End Function

'La función en versión inglesa:
Public Function fNumberToText(ByRef dbValue As Double, _
                        Optional ByRef strCurrency As String = "EURO", _
                        Optional ByRef strFractionCurrency As String = "CENT", _
                        Optional ByRef strConcatenator As String = "WITH", _
                        Optional ByRef intDecimals As Integer = 2) As String
    
    Application.Volatile (False)
    Dim strSeparatorThousands As String, strSeparatorDecimals As String
    Dim strAbsolut As String, strDecimals As String
    Dim lgAbsolut As Long, lgDecimal As Long
    Dim strText As String, strTextDecimal As String, strTextFinal As String
    Dim lgMultiplicator As Long
    
    'Si se leen números (procedentes de fuentes externas) que no se corresponden con la configuración numérica del usuario
    'strSeparatorThousands = GetValueCR(15)
    'strSeparatorDecimals = GetValueCR(14)
    '

    If VBA.Abs(dbValue) >= 10000000000# Then fNumberToText = "#Over the límit#": Exit Function
    
    If strCurrency = "" Then strCurrency = ""
    lgAbsolut = VBA.Abs(VBA.Fix(dbValue))
    
    strText = fConvertInteger(lgAbsolut, strCurrency)

    lgMultiplicator = VBA.Val(1 & VBA.String(intDecimals, "0"))
    lgDecimal = VBA.CInt((VBA.Abs(dbValue) - VBA.Abs(Fix(dbValue))) * lgMultiplicator)
    strTextDecimal = fConvertInteger(lgDecimal, strFractionCurrency)

    strTextFinal = VBA.Trim(strText & " " & strConcatenator & " " & strTextDecimal)
    If dbValue < 0 Then strTextFinal = "MINUS " & strTextFinal
    Do Until VBA.InStr(1, strTextFinal, "  ") = 0
        strTextFinal = VBA.Replace(strTextFinal, "  ", " ")
    Loop
    fNumberToText = strTextFinal
End Function

Public Function fConvertInteger(ByVal lgAbsolut As Long, ByRef strCurrency As String) As String
    Dim Hundreds As Long, Thousands As Long, Millions As Long, Billions As Long
    Dim strTextBillones As String, strTextBillions As String, strTextMillions As String, _
        strTextThousands As String, strTextHundreds As String, strTextDecimals As String
    Dim strText As String, strTextFinal As String
    
    Hundreds = (lgAbsolut - 1000 * (lgAbsolut \ 1000))
    Thousands = (lgAbsolut - 1000000 * (lgAbsolut \ 1000000)) \ 1000
    Millions = (lgAbsolut - 1000000000 * (lgAbsolut \ 1000000000)) \ 1000000
    Billions = (lgAbsolut - Millions * 1000000 - Thousands * 1000 - Hundreds) \ 1000000000
    strTextHundreds = fConvertQuantity(Hundreds)
    strTextThousands = fConvertQuantity(Thousands)
    strTextMillions = fConvertQuantity(Millions)
    strTextBillions = fConvertQuantity(Billions)
                        
    If lgAbsolut = "0" Then
        strTextHundreds = VBA.IIf(strCurrency <> "", "ZERO ", "")
    ElseIf lgAbsolut = "1" Then
        strTextHundreds = "ONE "
    Else
        strTextHundreds = strTextHundreds & " "
    End If
    
    If lgAbsolut >= 1000 Then
        If VBA.Trim(strTextThousands) = "ONE" Then
            strText = strText & " THOUSAND"
        ElseIf VBA.Trim(strTextThousands) = "" Then
            strText = strText
        Else
            strText = strTextThousands & " THOUSAND"
        End If
    End If

    strText = strText & " " & strTextHundreds
    
    If lgAbsolut >= 1000000 Then
        strText = VBA.IIf(VBA.Trim(strTextMillions) = "ONE", strTextMillions & " MILLION ", strTextMillions & " MILLIONS ") & _
                    strText
    End If
    
    If lgAbsolut >= 1000000000 Then
        strText = VBA.IIf(VBA.Trim(strTextBillions) = "ONE", strTextBillions & " BILLION ", strTextBillions & " BILLIONS ") & _
                    strText
    End If

    'If VBA.Abs(dbValue) >= 1000000000000# Then
    '    strText = VBA.IIf(VBA.Trim(strTextBillions) = "ONE", strTextBillions & " TRILLION ", strTextBillions & " TRILLIONS ") & _
    '                strText
    'End If

    fConvertInteger = strText
    
End Function

Public Function fConvertQuantity(ByVal lgValue As Long) As String
    Dim strHundreds As String, strTens As String, strUnity As String
    Dim matrizUnities As Variant
    Dim matrizTens As Variant
    Dim matrizTenss As Variant
    Dim matrizTenssY As Variant
    Dim matrizHundreds As Variant

    matrizUnities = Array("", "ONE", "TWO", "THREE", "FOUR", "FIVE", "SIX", "SEVEN", "EIGHT", "NINE")
    matrizTens = Array("", "ELEVEN", "TWELVE", "THIRTEEN", "FOURTEEN", "FIFTEEN", "SIXTEEN", "SEVENTEEN", "EIGHTEEN", "NINETEEN")
    matrizTenss = Array("", "TEN", "TWENTY", "THIRTY", "FOURTY", "FIFTY", "SIXTY", "SEVENTY", "EIGHTY", "NINETY")
    matrizTenssY = Array("", "", "TWENTY ", "THIRTY ", "FOURTY ", "FIFTY ", "SIXTY ", "SEVENTY ", "EIGHTY ", "NINETY ")
    matrizHundreds = Array("", "ONE HUNDRED", "TWO HUNDREDS", "THREE HUNDREDS", "FOUR HUNDREDS", "FIVE HUNDREDS", _
                          "SIX HUNDREDS", "SEVEN HUNDREDS", "EIGHT HUNDREDS", "NINE HUNDREDS")
    
    Dim Unity As Integer, Tens As Integer, Hundreds As Integer
    Hundreds = lgValue \ 100
    Tens = (lgValue - Hundreds * 100) \ 10
    Unity = (lgValue - Hundreds * 100 - Tens * 10)
    
    strUnity = VBA.IIf(Tens <> 1, matrizUnities(Unity), matrizTens(Unity))
    
    strTens = VBA.IIf(Tens > 1, matrizTens(Unity), strTens)
    strTens = VBA.IIf(Unity > 0, matrizTenssY(Tens), matrizTenss(Tens))
    
    strHundreds = matrizHundreds(Hundreds)
    fConvertQuantity = strHundreds & " " & strTens & strUnity

End Function

UDF that runs althought not called

adulador

New Member

Excel Facts

pgc01

MrExcel MVP

adulador

New Member

pgc01

MrExcel MVP

adulador

New Member

adulador

New Member

adulador

New Member

ZVI

MrExcel MVP

adulador

New Member

adulador

New Member

Similar threads

Forum statistics

Share this page

UDF that runs althought not called

New Member

Excel Facts

MrExcel MVP

New Member

MrExcel MVP

New Member

New Member

New Member

MrExcel MVP

New Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock