Fraction Format (Re-Explained)

[ToddG]

I'm really sorry for the repost on this but i'm getting desperate on this one. I know it's probably pretty simple but obviously i'm no expert here :wink:

Hopefully this explains it better:

The attached code is joining the values of two cells (in columns B & C) and putting an "x" between them (not multiplying, just an "x")

Example:

5.125 x 1.5

What I need is the decimal values to show as fractions in this string

Example:

5 1/8 x 1 1/2


If anyone could take a look i'd REALLY appreciate it!

Code:

For Each c In Range("D:D")
If c.Value = "Total" Then
c.Offset(0, 1) = Cells(c.Row, "b") & " x " & Cells(c.Row, "c")
End If
Next c

 

[Damon Ostrander]

Hi ,

I suggest you add this user-defined function to your code module:

Function FormatFraction(DecimalNumber As Single, Optional SmallestFrac As Integer = 16) As String

' DecimalNumber is the number to be expressed as a whole part and fraction thereof
' Format will display the result in string format, reducing the denominator
' to the smallest possible within the constraints of bringing the number to the nearest
' sixteenth. The optional parameter SmallestFrac allows you to set the largest
' denominator to something other than sixteenths (set to 8 for eights, etc.)

Dim WholePart As Integer
Dim FractPart As Single
Dim Numerator As Integer
Dim Denominator As Integer

WholePart = Fix(DecimalNumber)
FractPart = Abs(DecimalNumber - WholePart)
Denominator = SmallestFrac
Numerator = Fix(FractPart * SmallestFrac + 0.5) '0.5 Rounds to nearest 16th

' Reduce numerator and denominator by factors of 2
Do Until Numerator / 2 <> Numerator \ 2 Or Numerator < 2
Denominator = Denominator / 2
Numerator = Numerator / 2
Loop

' Format the result into a string
If Numerator <> 0 Then
If Denominator = 1 Then
FormatFraction = CStr(WholePart + Sgn(DecimalNumber))
Else
FormatFraction = CStr(WholePart) & " " & CStr(Numerator) & "/" & CStr(Denominator)
End If
Else
FormatFraction = CStr(WholePart)
End If

End Function



Then you could accomplish what you describe via:

For Each c In Range("D:D")
If c.Value = "Total" Then
c.Offset(0, 1) = FormatFraction(Cells(c.Row, "b")) & " x " & FormatFraction(Cells(c.Row, "c") )
End If

Note that the default is for the smallest fraction reduction to be in sixteenths, but that you can make it eighths or whatever by setting it like this:

c.Offset(0, 1) = FormatFraction(Cells(c.Row, "b"),8) & " x " & FormatFraction(Cells(c.Row, "c") ,8)
Next c

 

[ToddG]

Thanks a MILLION Damon. Works great.

One minor little thing. If a value (the fraction) is less than 1 it leaves a 0 for the whole number.

Example: 0 3/4

Would it be an easy fix to eliminate this 0 for values less than 1?

 

[Yogi Anand]

Thanks a MILLION Damon. Works great.

One minor little thing. If a value (the fraction) is less than 1 it leaves a 0 for the whole number.

Example: 0 3/4

Would it be an easy fix to eliminate this 0 for values less than 1?

Hi ToodG:

In addition to Damon's UDF, you may also want to try the following code ...

Sub y_3()
    For Each cell In Range("B2:B" & Range("B65536").End(xlUp).Row)
        If cell <> "" Then cell(1, 3) = Evaluate("=TEXT(" & cell.Value & ",""# ?/??"")&"" x "" & TEXT(" & cell(1, 2).Value & ",""# ?/??"")")
    Next cell
End Sub

 

[Damon Ostrander]

Hi ToddG,

To get rid of the 0 in my code simply replace the code:

FormatFraction = CStr(WholePart) & " " & CStr(Numerator) & "/" & CStr(Denominator)

with:

FormatFraction = IIf(WholePart = 0, "", CStr(WholePart) & " ") & CStr(Numerator) & "/" & CStr(Denominator)