Consulting

Results 1 to 4 of 4

Thread: VBA Macro help needed

  1. #1
    VBAX Newbie
    Joined
    Jun 2018
    Posts
    5
    Location

    VBA Macro help needed

    hi, there
    I want to write the "Only seventy-three degrees and 50 part" in the form of "Only Seventy Three and a half degrees "

    Attached Files Attached Files

  2. #2
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    You have .75 and .7 what happens in this instance?
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  3. #3
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    The below code is available on the Microsoft support website, I have modified it to what I believe your needs are:
    'Main functionFunction SpellNumber(ByVal MyNumber)
        Dim Dollars, Cents, Temp, tmpNum, hlf As Boolean
        Dim DecimalPlace, Count
        ReDim Place(9) As String
        Place(2) = " Thousand "
        Place(3) = " Million "
        Place(4) = " Billion "
        Place(5) = " Trillion "
        hlf = False
        tmpNum = MyNumber
        MyNumber = Trim(Str(MyNumber))
        DecimalPlace = InStr(MyNumber, ".")
        If DecimalPlace > 0 Then
            Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
            MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
        End If
        Count = 1
        Do While MyNumber <> ""
            Temp = GetHundreds(Right(MyNumber, 3))
            If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
            If Len(MyNumber) > 3 Then
                MyNumber = Left(MyNumber, Len(MyNumber) - 3)
            Else
                MyNumber = ""
            End If
            Count = Count + 1
        Loop
        
        Select Case Cents
            Case ""
                Cents = ""
            Case "One"
                Cents = " and one part"
            Case "Fifty "
                If tmpNum < 1 Then
                    Cents = "half a degree"
                Else
                    Cents = " and a half degrees"
                End If
                hlf = True
            Case Else
                If tmpNum < 1 Then
                    Cents = Cents & " parts"
                Else
                    Cents = " and " & Cents & " parts"
                End If
        End Select
        
        Select Case Dollars
            Case ""
                If tmpNum < 1 And tmpNum > 0 Then
                    Dollars = ""
                ElseIf tmpNum = 0 Then
                    Dollars = "zero degrees"
                End If
            Case "One"
                Dollars = "one degree"
            Case Else
                If hlf = True Then
                    Dollars = Dollars
                Else
                    Dollars = Dollars & " degrees"
                End If
        End Select
        
        SpellNumber = Application.Trim("Only " & LCase(Dollars) & LCase(Cents))
    End Function
          
    ' Converts a number from 100-999 into text
    Function GetHundreds(ByVal MyNumber)
        Dim Result As String
        If Val(MyNumber) = 0 Then Exit Function
        MyNumber = Right("000" & MyNumber, 3)
        If Mid(MyNumber, 1, 1) <> "0" Then
            Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
        End If
        If Mid(MyNumber, 2, 1) <> "0" Then
            Result = Result & GetTens(Mid(MyNumber, 2))
        Else
            Result = Result & GetDigit(Mid(MyNumber, 3))
        End If
        GetHundreds = Result
    End Function
          
    ' Converts a number from 10 to 99 into text.
    Function GetTens(TensText)
        Dim Result As String
        Result = ""
        If Val(Left(TensText, 1)) = 1 Then
            Select Case Val(TensText)
                Case 10: Result = "Ten"
                Case 11: Result = "Eleven"
                Case 12: Result = "Twelve"
                Case 13: Result = "Thirteen"
                Case 14: Result = "Fourteen"
                Case 15: Result = "Fifteen"
                Case 16: Result = "Sixteen"
                Case 17: Result = "Seventeen"
                Case 18: Result = "Eighteen"
                Case 19: Result = "Nineteen"
                Case Else
            End Select
        Else
            Select Case Val(Left(TensText, 1))
                Case 2: Result = "Twenty "
                Case 3: Result = "Thirty "
                Case 4: Result = "Forty "
                Case 5: Result = "Fifty "
                Case 6: Result = "Sixty "
                Case 7: Result = "Seventy "
                Case 8: Result = "Eighty "
                Case 9: Result = "Ninety "
                Case Else
            End Select
            Result = Result & GetDigit _
                (Right(TensText, 1))
        End If
        GetTens = Result
    End Function
         
    ' Converts a number from 1 to 9 into text.
    Function GetDigit(Digit)
        Select Case Val(Digit)
            Case 1: GetDigit = "One"
            Case 2: GetDigit = "Two"
            Case 3: GetDigit = "Three"
            Case 4: GetDigit = "Four"
            Case 5: GetDigit = "Five"
            Case 6: GetDigit = "Six"
            Case 7: GetDigit = "Seven"
            Case 8: GetDigit = "Eight"
            Case 9: GetDigit = "Nine"
            Case Else: GetDigit = ""
        End Select
    End Function
    Hope this helps
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  4. #4
    VBAX Newbie
    Joined
    Jun 2018
    Posts
    5
    Location
    georgiboy

    ok. Thanks.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •