Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Hi folks, need some urgent help in converting a macro that I have to a Function in excel. I wrote this macro ages ago and having only recently come across functions would like to have this converted into a function. I would appreciate any help that can be provided.

Macro converts a decimal into a fraction. I prefer this one over the various others I have seen as they tend to have errors and have not computed the fractions accurately enough for my liking. This one you can set your own level of accuracy required, however, you do have to go into the programming to set the selection.numberformat="0.00000" to the number of decimal places required. It would be great if you could have an input box pop up and ask for level of accuracy say up to 10 decimal places.

The coding is provided in the as below:

Sub Dec_to_Frac()

'

' Decimal to Fraction Macro

' Macro recorded 09/05/00 by Baber Beg

'

M01 = ActiveCell.Value

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.FormulaR1C1 = "=R[-1]C"

Selection.NumberFormat = "0.000000" ‘set level of accuracy

M1F = ActiveCell.Value

M00 = 1

A:

M02 = M00 / M01

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Value = M02

Selection.NumberFormat = "0.00000" ‘one decimal less than provided above

M19 = ActiveCell.Value

M20 = M19 - Int(M19)

If M20 = 0 Then GoTo C

M00 = M00 + 1

ActiveCell.Offset(-1, 0).Range("A1").Select

GoTo A

C:

ActiveCell.Offset(2, 0).Range("A1").Select

If M00 > M02 Then GoTo D

ActiveCell.Value = M00

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.FormulaR1C1 = "'/"

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Value = M02

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-3]C,R[-2]C,R[-1]C)"

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Offset(-1, 0).Range("A1").Select

Selection.Copy

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Application.CutCopyMode = False

ActiveCell.Offset(-1, 0).Range("A1").Select

Do Until ActiveCell.Value = M01

Selection.EntireRow.Delete

ActiveCell.Offset(-1, 0).Range("A1").Select

Loop

Selection.EntireRow.Delete

End

D:

M03 = M00 / M02

M04 = Int(M03)

ActiveCell.Value = M04

ActiveCell.Offset(1, 0).Range("A1").Select

M05 = M03 - M04

ActiveCell.FormulaR1C1 = "' & "

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Value = M05 * M02

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.FormulaR1C1 = "'/"

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Value = M02

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-5]C,R[-4]C,R[-3]C,R[-2]C,R[-1]C)"

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Offset(-1, 0).Range("A1").Select

Selection.Copy

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Application.CutCopyMode = False

ActiveCell.Offset(-1, 0).Range("A1").Select

Do Until ActiveCell.Value = M01

Selection.EntireRow.Delete

ActiveCell.Offset(-1, 0).Range("A1").Select

Loop

Selection.EntireRow.Delete

End

' Dec to Frac

End Sub

Macro converts a decimal into a fraction. I prefer this one over the various others I have seen as they tend to have errors and have not computed the fractions accurately enough for my liking. This one you can set your own level of accuracy required, however, you do have to go into the programming to set the selection.numberformat="0.

The coding is provided in the as below:

Sub Dec_to_Frac()

'

' Decimal to Fraction Macro

' Macro recorded 09/05/00 by Baber Beg

'

M01 = ActiveCell.Value

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.FormulaR1C1 = "=R[-1]C"

Selection.NumberFormat = "0.000000" ‘set level of accuracy

M1F = ActiveCell.Value

M00 = 1

A:

M02 = M00 / M01

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Value = M02

Selection.NumberFormat = "0.00000" ‘one decimal less than provided above

M19 = ActiveCell.Value

M20 = M19 - Int(M19)

If M20 = 0 Then GoTo C

M00 = M00 + 1

ActiveCell.Offset(-1, 0).Range("A1").Select

GoTo A

C:

ActiveCell.Offset(2, 0).Range("A1").Select

If M00 > M02 Then GoTo D

ActiveCell.Value = M00

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.FormulaR1C1 = "'/"

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Value = M02

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-3]C,R[-2]

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Offset(-1, 0).Range("A1").Select

Selection.Copy

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Application.CutCopyMode = False

ActiveCell.Offset(-1, 0).Range("A1").Select

Do Until ActiveCell.Value = M01

Selection.EntireRow.Delete

ActiveCell.Offset(-1, 0).Range("A1").Select

Loop

Selection.EntireRow.Delete

End

D:

M03 = M00 / M02

M04 = Int(M03)

ActiveCell.Value = M04

ActiveCell.Offset(1, 0).Range("A1").Select

M05 = M03 - M04

ActiveCell.FormulaR1C1 = "' & "

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Value = M05 * M02

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.FormulaR1C1 = "'/"

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Value = M02

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-5]C,R[-4]

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Offset(-1, 0).Range("A1").Select

Selection.Copy

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Application.CutCopyMode = False

ActiveCell.Offset(-1, 0).Range("A1").Select

Do Until ActiveCell.Value = M01

Selection.EntireRow.Delete

ActiveCell.Offset(-1, 0).Range("A1").Select

Loop

Selection.EntireRow.Delete

End

' Dec to Frac

End Sub

Experts Exchange Solution brought to you by

Enjoy your complimentary solution view.

Get every solution instantly with premium.
Start your 7-day free trial.

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Is this going to be a spreadsheet function? Rather than an input box, perhaps a second parameter for the decimal place precision?

By the way, I'm doing a test run on your original code and its taking forever. Give me an example number you'd be using to convert to fraction. Is this supposed to only work with perfect fraction solutions? It runs if I put 11.75, but runs "forever" if I use 11.751

Dave

The code is old it's from I was learning vba. For example I have stopped the screen updating etc. also the code is longish towards the end, where it starts to delete the rows above, till the answer ends up in the cell below.

Try some of the simpler numbers for example 3.75 or 4.666 these should run quicker through the coding.

I am not too bothered about having the input box for the accuracy that was just an afterthought when I wrote the question. I normally have the first one set to five decimal places and the second selectnumber.format to four decimal places which seems satisfactory in most instances.

Baber

[A1]=11.5

[B1]=DecToFraction(A1,6) 'where 6 is the precision?

Or do you want this as macro where you are prompted (which I provided) that is just cleaned up (which I can do)?

Dave

For quality assurance, can you provide a dozen or so numbers for comparison to the function?

Dave

I've taken that into account on review and now am testing to see if relative accuracy can be affected more correctly.

If I'm mistaken, please correct me. I know this is "urgent' but want to ensure you get something that works appropriately.

PS - this will run very fast, as opposed to the subroutine approach, so there will be payout on this effort!

Dave

Without the precision constraint, the routine gets answers like 15.002 = 15 & 3/1500 as opposed to getting 15 & 1/500 which is correct with the precision constraint you designed but wasn't working in the original routine.

------------------

Another "feature" is cleaning up the precision beyond the decimal place which seems incorrect:

Example - the routine gets answers like 15.207 = 15 & 206.99999999999997/1000 for example, when it should be returning 15.207 = 15 & 207/1000

------------------

Ok - beauty is in the eyes of the beholder, and you have easy options to make the function work exactly like your sub, if you need that. Hopefully, I've given you something that is actually more accurate & responsive to the need - and fast!

Declaration:

Dec_to_Frac(r as Range, Optional xDecPlaces as Long=0) as String

Usage:

=Dec_to_Frac(A1) 'defaults to infinite precision (within Excel limitations)

or

=Dec_to_Frac(A1,0) 'same as above

or

=Dec_to_Frac(A1,6) 'sets precision to 6 decimals past the "."

Here's the code:

```
Function Dec_to_Frac(r As Range, Optional xDecPlaces As Long = 0) As String
'
' Decimal to Fraction Macro
' Macro recorded 09/05/00 by Baber Beg
'
'if xDecPlaces = 0, then no precision settings are used
Dim rNumber As Range
Dim M00 As Double
Dim M01 As Double
Dim M02 As Double
Dim M04 As Double
Dim M19 As Variant
Dim M20 As Double
Dim M1F As Variant
Dim M2F As Variant
Dim M3F As Variant
Dim M4F As Variant
Dim M5F As Variant
Dim M6F As Variant
Dim M7F As Variant
Dim M8F As Variant
Dim M9F As Variant
Dim M10F As Variant
Set rNumber = r.Cells(1, 1)
M01 = rNumber.Value
M1F = IIf(xDecPlaces = 0, M01, Format(M01, "0." & WorksheetFunction.Rept("0", xDecPlaces))) 'set level of accuracy
A:
Do
M00 = M00 + 1
M02 = M00 / M1F 'not M01, so that precision dicated will be utilized
If xDecPlaces > 0 Then
M2F = Format(M02, "0." & WorksheetFunction.Rept("0", xDecPlaces - 1)) 'one decimal less than provided above
Else
M2F = M02
End If
M19 = M2F
M20 = M19 - Int(M19)
Loop Until M20 = 0
C:
If M00 <= M02 Then
M3F = M00 'one cell down
M4F = "/"
M5F = M02
Dec_to_Frac = M3F & M4F & M5F
Else
D:
M03 = M00 / M02
M04 = Int(M03)
M6F = M04
m05 = M03 - M04
M7F = " & "
M8F = m05 * M02
M9F = "/"
M10F = M02
'------- ELIMINATE THIS SECTION IF YOU WANT TO DISPLAY 0 NUMERATOR and/or .99999999/1000 type display
'clean up long strings of 0's or 9's which should improve accuracy
If Abs(M8F - Int(M8F)) < 0.0000000001 Or Abs(M8F - Int(M8F)) > 0.9999999999 Then
If Abs(M8F - Int(M8F)) < 0.0000000001 Then
M8F = Int(M8F)
Else
M8F = Int(M8F) + 1
End If
'eliminate fractional display if 0 is the numerator
If M8F = 0 Then
M7F = vbNullString
M8F = vbNullString
M9F = vbNullString
M10F = vbNullString
End If
End If
'------- END OF CLEANUP SECTION WHICH CAN BE ELIMINATED IF YOU DON'T LIKE IT
Dec_to_Frac = M6F & M7F & M8F & M9F & M10F
End If
' Dec to Frac
End Function
```

See attached.

Cheers!

Dave

decToFraction-r1.xls

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trialNote the custom format is:

# & ????/????

Check out attached worksheet - no functions, just using custom formats.

Dave

decToFraction-r2.xls

Microsoft Applications

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Experts Exchange Solution brought to you by

Enjoy your complimentary solution view.

Get every solution instantly with premium.
Start your 7-day free trial.

Open in new window

Cheers,

Dave