Rounding Fractions

[Carl Brehm]

b3=
300x260x500

b4 =
=(TEXT(CONVERT((LEFT(B3,(SEARCH("x",B3)-1))),"mm","in"),"# ?/16"))&""" X
"&(TEXT(CONVERT(MID(B3,(SEARCH("x",B3)+1),((LEN(B3))-(LEFT(SEARCH("x",B3)))-
(RIGHT(SEARCH("x",B3))))),"mm","in"),"# ?/16"))&""" X
"&(TEXT(CONVERT((RIGHT(B3,(RIGHT(SEARCH("x",B3))-1))),"mm","in"),"#
?/16"))&""""

results =
11 13/16" X 10 4/16" X 19 11/16"

Need to convert the fractions to lowest common denominator
Have tried following the examples at
http://www.mvps.org/dmcritchie/excel/fractex1.htm and can not get it to work

There has to be an easier way to do this. Formula is already 282 characters
in length. and having to use this 10,000 times in a workbook would make it
way to large.
Can you make the formula into a user defined function?

Function METtoFRA(ctc as range)

(TEXT(CONVERT((LEFT(ctc,(SEARCH("x",ctc)-1))),"mm","in"),"# ?/16"))&""" X
"&(TEXT(CONVERT(MID(ctc,(SEARCH("x",ctc)+1),((LEN(ctc))-(LEFT(SEARCH("x",ctc
)))-(RIGHT(SEARCH("x",ctc))))),"mm","in"),"# ?/16"))&""" X
"&(TEXT(CONVERT((RIGHT(ctc,(RIGHT(SEARCH("x",ctc))-1))),"mm","in"),"#
?/16"))&""""

end function

or some such where you could usel it =METtoFRA(b3)

--
Carl & Linda Brehm
Lake Lafourche Bird House
Hebert, LA
Keets, Tiels, GN Lories, Quakers
Mitred Conures, TAG's, Bourkes
Cages

 

[Keith R]

Carl-

I think this might help you... have not double checked it for accuracy.
If you need to reduce the fractions even further (e.g. show 3/4 instead of
12/16), then that would take a little more code.

HTH,
Keith R

Function METtoFRA(SourceCell As Range)

'grab the cell value and pull out the three measurements
ParseValue = SourceCell.Value
ParsePoint1 = InStr(1, ParseValue, "x", vbTextCompare)
ParsePoint2 = InStr(ParsePoint1 + 1, ParseValue, "x", vbTextCompare)
ParseX = Left(ParseValue, ParsePoint1 - 1)
ParseY = Mid(ParseValue, ParsePoint1 + 1, (ParsePoint2 - ParsePoint1) - 1)
ParseZ = Right(ParseValue, Len(ParseValue) - ParsePoint2)

'converts to 1/16 inches
NewX = (Val(ParseX) / 25) * 16
NewY = (Val(ParseY) / 25) * 16
NewZ = (Val(ParseZ) / 25) * 16

'calculates whole inches
NewXLeft = (NewX \ 16)
NewYLeft = (NewY \ 16)
NewZLeft = (NewZ \ 16)

'calculates remainder for fraction
NewXRight = (NewX Mod 16)
NewYRight = (NewY Mod 16)
NewZRight = (NewZ Mod 16)

METtoFRA = NewXLeft & " " & NewXRight & "/16 x " & _
NewYLeft & " " & NewYRight & "/16 x " & _
NewZLeft & " " & NewZRight & "/16"

End Function

 

[AlfD]

Hi!

Do you have to start with the 3 dimensions all in the same column? An
even if they arrive like that you could soon split them up (data|Tex
to columns).

Could you use a simple lookup table of all relevant "imperial" measure
(which seem to be limited to intervals of 1/16, so the number won'
probably be too gigantic) against their metric equivalents. Or maybe
tables if you wanted, say, to covert from mm to inches at 10m
intervals.

If so, what you get out of the table will be what you put into it (n
more 4/16 if you want 1/4).

Al

 

[Dana DeLouis]

Would this work for you?

Function METtoFRA(rng As Range) As String
Dim v As Variant
Dim j As Long
Dim k2 As String

' mm to inch
Const mm_in As Double = 3.93700787401575E-02
k2 = Chr(34) & " x " & Chr(34)

v = Split(rng.Value, "x")
With WorksheetFunction
For j = LBound(v) To UBound(v)
v(j) = .Text(v(j) * mm_in, "0 ##/16")
Next j
End With
METtoFRA = Join(v, k2)
End Function

Sub Testit()
[A1] = "300x260x500"
Debug.Print METtoFRA([A1])
End Sub

Returns:

11 13/16" x "10 4/16" x "19 11/16

 

[Harlan Grove]

b3=
300x260x500

b4 =
=(TEXT(CONVERT((LEFT(B3,(SEARCH("x",B3)-1))),"mm","in"),"# ?/16"))&""" X
"&(TEXT(CONVERT(MID(B3,(SEARCH("x",B3)+1),((LEN(B3))-(LEFT(SEARCH("x",B3)))-
(RIGHT(SEARCH("x",B3))))),"mm","in"),"# ?/16"))&""" X
"&(TEXT(CONVERT((RIGHT(B3,(RIGHT(SEARCH("x",B3))-1))),"mm","in"),"#
?/16"))&""""

results =
11 13/16" X 10 4/16" X 19 11/16"

Need to convert the fractions to lowest common denominator

...

You could try

=TEXT(ROUND(LEFT(B3,SEARCH("x",B3)-1)*CONVERT(16,"mm","in"),0)/16,"0 #/##\""")
&" x "&TEXT(ROUND(MID(B3,SEARCH("x",B3)+1,SEARCH("x",SUBSTITUTE(B3,"x"," ",1))
-SEARCH("x",B3)-1)*CONVERT(16,"mm","in"),0)/16,"0 #/##\""")&" x "
&TEXT(ROUND(MID(B3,SEARCH("x",SUBSTITUTE(B3,"x"," ",1))+1,256)
*CONVERT(16,"mm","in"),0)/16,"0 #/##\""")

which is still fairly long. You could use defined names like mm_in referring to
=CONVERT(16,"mm","in"), fmt referring to ="0 #/##\"" x " and fmz referring to
="0 #/##\""". Then you could shorten the formula above to

=TEXT(ROUND(LEFT(B3,SEARCH("x",B3)-1)*mm_in,0)/16,fmt)&TEXT(ROUND(MID(B3,
SEARCH("x",B3)+1,SEARCH("x",SUBSTITUTE(B3,"x"," ",1))-SEARCH("x",B3)-1)
*mm_in,0)/16,fmt)&TEXT(ROUND(MID(B3,SEARCH("x",SUBSTITUTE(B3,"x"," ",1))+1,
256)*mm_in,0)/16,fmz)

 

[AlfD]

Hi again!

When I suggested a lookup table I hadn't given much thought as to ho
you would populate it. Well, I have now.
Here's a scenario:

You have 300x200x120 or something similar as your text entries.
Let's assume you use data|Text to Columns to put the 3 dimensions i
separate columns (you have a convenient separator in the 'x').

Put as many millimetric values as you need in col A (e.g. 10 to 1000 i
steps of 10 (you choose)).
Column B is CONVERT(A1,"mm","in") and is formatted as Fraction
sixteenths.
Obviously the true values in B are not precise sixteenths.
Now the dangerous bit. Just don't have any other workbooks/sheet
around. Go to Tools|Options and on the calculation tab check Precisio
as Displayed. This will "fix" the sixteenths as exact, rather tha
approximate. If you check them, they should all be nice obedien
multiples of 0.0625.
Go back and get rid of the check mark on Precision as Displayed.

But these 16ths are not reduced to their simplest state. So: firs
strip off the integer bit :Column C =if(int(B1)=0,"",Int(B1)).
Puts a blank if the integer bit is zero.
Now get a handle on the fractional bit: Column D is =MOD(B1,16) .
This will yield numbers from 0 to 15 (the number of sixteenths yo
have) if you format this column to show 16ths.

Penultimate step is Column E to hold
=C1&" "&IF(E1=0,"",IF(MOD(D1,8)=0,D1/8
"/2",IF(MOD(D1,4)=0,D1/4 &"/4",IF(MOD(D1,2)=0,D1/2 &"/8",D
&"/16")))).
This is just text processing according to whether they are halves
quarters etc.

I say penultimate, though the data is now apparently in the requisit
format to go in the lookup table.

But one more step: copy the last column (E) and Paste Special|Value
into another column.
This last column is usable. In fact, it never amazes me to find you ca
do all that to some erstwhile numbers and find they will still behav
like numbers. Well, most of them. 10mm and 20mm (both less than 1 inch
won't because they begin with "", I suppose.

I just thought you might find something of interest in here!

Al

 

[Carl Brehm]

How would you get it to reduce the 4/16 to 1/4?
In most cases the x used is a capitol "X", if it is a little "x" the
following code returns #VALUE!
Split() wants the x to be exact where as to Search() in Excel it makes no
difference between "x" and "X".
Need both to work.

Thanks, I modified it a little to make the output look right.
Old Output 11 13/16" x "10 4/16" x "19 11/16
New Output 11 13/16" X 10 4/16" X 19 11/16"


Function METtoFRA(rng As Range) As String

Dim v As Variant
Dim j As Long
Dim k2 As String
Dim mf As Variant
Dim k3 As String

' mm to inch
Const mm_in As Double = 3.93700787401575E-02
k2 = """ X "
k3 = """"
v = Split(rng.Value, "X")
With WorksheetFunction
For j = LBound(v) To UBound(v)
v(j) = .Text(v(j) * mm_in, "0 ##/16")
Next j
End With
mf = Join(v, k2)
METtoFRA = mf & k3
End Function

--
Carl & Linda Brehm
Lake Lafourche Bird House
Hebert, LA
Keets, Tiels, GN Lories, Quakers
Mitred Conures, TAG's, Bourkes
Cages

 

[Keith R]

Alf's posts got me thinking too

If you want to reduce your fraction, you could simply loop and check if the
numerator is divisible by 2, in which case, divide both the numerator and
denominator by 2- keep looping the numerator value until it is no longer
evenly divisible by two, then exit the loop.

As for the "x" vs "X" problem, just use an OR statement or check for both
and (in case they both exist, mixed string) take the lower value that is >0

HTH,
Keith R

Carl-

I think this might help you... have not double checked it for accuracy.
If you need to reduce the fractions even further (e.g. show 3/4 instead of
12/16), then that would take a little more code.

ParsePoint1 = InStr(1, ParseValue, "x", vbTextCompare)

<snip>

 

[Dana DeLouis]

Well, here is just one way that I would do it. This would require the ATP
however. The idea here is that it appears you want to round your answers to
the nearest 1/16th, and then try to reduce that fraction if possible.

Function METtoFRA(rng As Range) As String
'// Dana DeLouis
Dim v As Variant
Dim j As Long
Const MRound As String = "ATPVBAEN.XLA!MRound"
' mm to inch
Const mm_in As Double = 3.93700787401575E-02

v = Split(UCase(rng.Value), "X")
With WorksheetFunction
For j = LBound(v) To UBound(v)
v(j) = .Text(Run(MRound, v(j) * mm_in, 1 / 16), "0 ##/##")
Next j
End With
METtoFRA = Join(v, """ X ") & """"
End Function

Sub Testit()
[A1] = "300x260x500"
Debug.Print METtoFRA([A1])
End Sub

11 13/16" X 10 1/4" X 19 11/16"


Just for fun, here is another way that somehow works. One wouldn't guess
that it would at first. Having to "Evaluate" can sometimes be slow, so it
would be better to use other methods if you can.

Function METtoFRA(rng As Range) As String
Dim v As Variant
Dim j As Long
Dim k2 As String

' mm to inch
Const mm_in As Double = 3.93700787401575E-02
k2 = """ X "

v = Split(UCase(rng.Value), "X")
With WorksheetFunction
For j = LBound(v) To UBound(v)
v(j) = Evaluate(.Text(v(j) * mm_in, "0+??/16"))
v(j) = .Text(v(j), "0 ##/##")
Next j

End With
METtoFRA = Join(v, k2) & """"
End Function

HTH :>)

 

[Carl Brehm]

Thanks, I should have checked this earlier. I just spent 5 hours making
this.
Not as clean, but at least it was a learning experience. Pass the aspirin
please.
I evan experimented with ISEVAN for a while before remembering I had got
ATPVBAEN.xla last year.

Function METtoFRA(rng As Variant) As Variant
'On Error Resume Next

Dim v As Variant
Dim j As Long
Dim k2 As String
Dim mf As Variant
Dim k3 As String
Dim mm_in As Double
Dim RNG1 As Variant
Dim m As String

RNG1 = UCase(rng.Value)
' mm to inch
mm_in = 3.93700787401575E-02
k2 = """ X "
k3 = """"
m = "ATPVBAEN.XLA!MRound"

v = Split(RNG1, ("X"))

With WorksheetFunction
For j = LBound(v) To UBound(v)
v(j) = .Text(Run(M, v(j) * mm_in, 1 / 16), "0 ##/##")
Next j
End With
mf = Join(v, k2)
METtoFRA = mf & k3
End Function
--
Carl & Linda Brehm
Lake Lafourche Bird House
Hebert, LA
Keets, Tiels, GN Lories, Quakers
Mitred Conures, TAG's, Bourkes
Cages

Well, here is just one way that I would do it. This would require the ATP
however. The idea here is that it appears you want to round your answers to
the nearest 1/16th, and then try to reduce that fraction if possible.

Function METtoFRA(rng As Range) As String
'// Dana DeLouis
Dim v As Variant
Dim j As Long
Const MRound As String = "ATPVBAEN.XLA!MRound"
' mm to inch
Const mm_in As Double = 3.93700787401575E-02

v = Split(UCase(rng.Value), "X")
With WorksheetFunction
For j = LBound(v) To UBound(v)
v(j) = .Text(Run(MRound, v(j) * mm_in, 1 / 16), "0 ##/##")
Next j
End With
METtoFRA = Join(v, """ X ") & """"
End Function

Sub Testit()
[A1] = "300x260x500"
Debug.Print METtoFRA([A1])
End Sub

11 13/16" X 10 1/4" X 19 11/16"


Just for fun, here is another way that somehow works. One wouldn't guess
that it would at first. Having to "Evaluate" can sometimes be slow, so it
would be better to use other methods if you can.

Function METtoFRA(rng As Range) As String
Dim v As Variant
Dim j As Long
Dim k2 As String

' mm to inch
Const mm_in As Double = 3.93700787401575E-02
k2 = """ X "

v = Split(UCase(rng.Value), "X")
With WorksheetFunction
For j = LBound(v) To UBound(v)
v(j) = Evaluate(.Text(v(j) * mm_in, "0+??/16"))
v(j) = .Text(v(j), "0 ##/##")
Next j

End With
METtoFRA = Join(v, k2) & """"
End Function

HTH :>)
--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =

How would you get it to reduce the 4/16 to 1/4?
In most cases the x used is a capitol "X", if it is a little "x" the
following code returns #VALUE!
Split() wants the x to be exact where as to Search() in Excel it makes no
difference between "x" and "X".
Need both to work.

Thanks, I modified it a little to make the output look right.
Old Output 11 13/16" x "10 4/16" x "19 11/16
New Output 11 13/16" X 10 4/16" X 19 11/16"


Function METtoFRA(rng As Range) As String

Dim v As Variant
Dim j As Long
Dim k2 As String
Dim mf As Variant
Dim k3 As String

' mm to inch
Const mm_in As Double = 3.93700787401575E-02
k2 = """ X "
k3 = """"
v = Split(rng.Value, "X")
With WorksheetFunction
For j = LBound(v) To UBound(v)
v(j) = .Text(v(j) * mm_in, "0 ##/16")
Next j
End With
mf = Join(v, k2)
METtoFRA = mf & k3
End Function

--
Carl & Linda Brehm
Lake Lafourche Bird House
Hebert, LA
Keets, Tiels, GN Lories, Quakers
Mitred Conures, TAG's, Bourkes
Cages