Function to convert string

C

Carl Brehm

This works but takes to much space

(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"))&""""

Some times the "x" is "*" so need

need Function ConMet(Rrange as range, Xoperator as string)

so in Spreadsheet can just call
=ConMet(B3, x) where x is what ever symbol used as separator


Thanks

--
Carl Brehm
Lake Lafourche Bird House
Hebert, LA

Keets, Tiels, GN Lories, Quakers
Mitred Conures, TAG's, Bourkes
Lovebirds, Cherry Head Conures
Prince of Whales

Wholesale Cages to Breeders & Pet Stores
 
K

keepITcool

Carl

This should do:
but it will work only for excel 2000 or newer..


Function ConvMM(s As String)
Dim i, v
On Error GoTo oops
i = InStr(LCase$(s), "x")
If i = 0 Then i = InStr(s, "*")
If i = 0 Then GoTo oops
v = Split(s, Mid(s, i, 1))
For i = 0 To 1
v(i) = Format( _
Evaluate("=convert(" & v(i) & ",""mm"",""in"")"), _
"# 1/16")
Next
ConvMM = Join(v, " X ")
Exit Function
oops:
ConvMM = CVErr(xlErrNA)
End Function


keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >
 
R

Ron Rosenfeld

Some times the "x" is "*" so need

need Function ConMet(Rrange as range, Xoperator as string)

so in Spreadsheet can just call
=ConMet(B3, x) where x is what ever symbol used as separator
Click to expand...

I had some fun with this.

You don't need to specify the separator as the UDF can figure it out, since
it's always the same and non-numeric.

I also wrote this so you could have any number of dimensions from 2 to n.

Finally, and you may not want this, I output the fraction as simplified
fractions. In other words, instead of 8/16 the fraction would be 1/2.

See what you think.

=========================================
Option Explicit
Function ConMet(Val As Range) As String
Dim Dimensions() As Double
Dim NumDimensions As Integer
Dim i As Integer, j As Integer
Dim FractNumerator As Integer
Dim FractDenominator As Integer
Dim Fraction As String
Dim S() As Integer
Dim Sep As String

For i = 1 To Len(Val.Text)
Sep = Mid(Val.Text, i, 1)
If Not IsNumeric(Sep) Then Exit For
Next i

If IsNumeric(Sep) Then
MsgBox ("More than One Dimension Required")
Exit Function
End If

NumDimensions = Len(Val.Text) - _
Len(Application.WorksheetFunction.Substitute(Val.Text, Sep, ""))

ReDim Dimensions(NumDimensions)
ReDim S(NumDimensions - 1)

Const mmPerInch As Double = 25.4

S(0) = InStr(1, Val.Text, Sep)
For i = 1 To UBound(S)
S(i) = InStr(S(i - 1) + 1, Val.Text, Sep)
Next i

Dimensions(0) = Left(Val.Text, S(0) - 1)
For i = 1 To UBound(S)
Dimensions(i) = Mid(Val.Text, S(i - 1) + 1, S(i) - S(i - 1) - 1)
Next i
Dimensions(i) = Mid(Val.Text, S(i - 1) + 1, Len(Val.Text) - S(i - 1))



For i = 0 To NumDimensions
Dimensions(i) = Dimensions(i) / mmPerInch
ConMet = ConMet & Int(Dimensions(i))
FractNumerator = Round(16 * (Dimensions(i) - Int(Dimensions(i))), 0)
FractDenominator = 16
For j = 0 To 3
If FractNumerator Mod 2 = 1 Then Exit For
FractNumerator = FractNumerator / 2
FractDenominator = FractDenominator / 2
Next j
If FractNumerator = 0 Then
Fraction = ""
Else
Fraction = FractNumerator & "/" & FractDenominator
End If

ConMet = ConMet & " " & Fraction & " " & Sep & " "
Next i

ConMet = Left(ConMet, Len(ConMet) - 3)

End Function
==================================

--ron
 
R

Ron Rosenfeld

This works but takes to much space

(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"))&""""

Some times the "x" is "*" so need

need Function ConMet(Rrange as range, Xoperator as string)

so in Spreadsheet can just call
=ConMet(B3, x) where x is what ever symbol used as separator


Thanks
Click to expand...

Keeping a bit more to your format in the above, by always using 'X' in the
output format and also adding on the " :

============================
Option Explicit
Function ConMet(Val As Range) As String
Dim Dimensions() As Double
Dim NumDimensions As Integer
Dim i As Integer, j As Integer
Dim FractNumerator As Integer
Dim FractDenominator As Integer
Dim Fraction As String
Dim s() As Integer
Dim Sep As String

For i = 1 To Len(Val.Text)
Sep = Mid(Val.Text, i, 1)
If Not IsNumeric(Sep) Then Exit For
Next i

If IsNumeric(Sep) Then
MsgBox ("More than One Dimension Required")
Exit Function
End If

NumDimensions = Len(Val.Text) - _
Len(Application.WorksheetFunction.Substitute(Val.Text, Sep, ""))

ReDim Dimensions(NumDimensions)
ReDim s(NumDimensions - 1)

Const mmPerInch As Double = 25.4

s(0) = InStr(1, Val.Text, Sep)
For i = 1 To UBound(s)
s(i) = InStr(s(i - 1) + 1, Val.Text, Sep)
Next i

Dimensions(0) = Left(Val.Text, s(0) - 1)
For i = 1 To UBound(s)
Dimensions(i) = Mid(Val.Text, s(i - 1) + 1, s(i) - s(i - 1) - 1)
Next i
Dimensions(i) = Mid(Val.Text, s(i - 1) + 1, Len(Val.Text) - s(i - 1))



For i = 0 To NumDimensions
Dimensions(i) = Dimensions(i) / mmPerInch
ConMet = ConMet & Int(Dimensions(i))
FractNumerator = Round(16 * (Dimensions(i) - Int(Dimensions(i))), 0)
FractDenominator = 16
For j = 0 To 3
If FractNumerator Mod 2 = 1 Then Exit For
FractNumerator = FractNumerator / 2
FractDenominator = FractDenominator / 2
Next j
If FractNumerator = 0 Then
Fraction = """"
Else
Fraction = FractNumerator & "/" & FractDenominator & """"
End If

ConMet = ConMet & " " & Fraction & " " & "X" & " "
Next i

ConMet = Left(ConMet, Len(ConMet) - 3)

End Function
===============================

--ron
 
R

Ron Rosenfeld

Carl

This should do:
but it will work only for excel 2000 or newer..


Function ConvMM(s As String)
Click to expand...

One of us is misunderstanding something.

For input of

300x200x100

The OP's formula gives:

11 13/16" X 7 14/16" X 3 15/16"

My (revised) UDF gives:

11 13/16" X 7 7/8" X 3 15/16"

but your UDF gives (on my machine -- XL 2002):

12 1/16 X 8 1/16 X 100



--ron
 
K

keepITcool

OP never gave his original input and I only glanced the the original
formula.. so I missed the 3rd dimension :)

in my code change

For i = 0 to 1
to
For i= lbound(v) To ubound(v)

and it should do 3 dims AND 2 dims





keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >
 
R

Ron Rosenfeld

OP never gave his original input and I only glanced the the original
formula.. so I missed the 3rd dimension :)

in my code change

For i = 0 to 1
to
For i= lbound(v) To ubound(v)

and it should do 3 dims AND 2 dims
Click to expand...

Your UDF still gives different values for the dimensions:

Input:
300x200x100

Your output:
12 1/16 X 8 1/16 X 4 1/16

My output:
11 13/16" X 7 7/8" X 3 15/16"

OP's output:
11 13/16" X 7 14/16" X 3 15/16"



--ron
 
K

keepITcool

hmm.. ouch :(

i think vba's format doesn't work with fractional ,
then again but excel's TEXT does. :)


Function ConvMM(Dimensions As String)
Dim i, v
On Error GoTo oops:
i = InStr(LCase$(Dimensions), "x")
If i = 0 Then i = InStr(Dimensions, "*")
If i = 0 Then GoTo oops
v = Split(Dimensions, Mid(Dimensions, i, 1))
For i = LBound(v) To UBound(v)
v(i) = Evaluate("=TEXT(" & v(i)/25.4 & ",""# ??/16"")")
Next
ConvMM = Join(v, " X ")
Exit Function
oops:
ConvMM = CVErr(xlErrNA)
End Function



keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >
 
R

Ron Rosenfeld

This works but takes to much space

(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"))&""""

Some times the "x" is "*" so need

need Function ConMet(Rrange as range, Xoperator as string)

so in Spreadsheet can just call
=ConMet(B3, x) where x is what ever symbol used as separator
Click to expand...

And simplified if you have a later version of Excel. Also handles 1
dimensional constructs:

=================================
Option Explicit
Function ConMet(Val As Range) As String
Dim Dimensions As Variant
Dim i As Integer, j As Integer
Dim FractNumerator As Integer
Dim FractDenominator As Integer
Dim Fraction As String
Dim Sep As String

Const mmPerInch As Double = 25.4

For i = 1 To Len(Val.Text)
Sep = Mid(Val.Text, i, 1)
If Not IsNumeric(Sep) Then Exit For
Next i

If IsNumeric(Sep) Then Sep = ""

Dimensions = Split(Val.Text, Sep, -1)

For i = 0 To UBound(Dimensions)
Dimensions(i) = Dimensions(i) / mmPerInch
ConMet = ConMet & Int(Dimensions(i))
FractNumerator = Round(16 * (Dimensions(i) - Int(Dimensions(i))), 0)
FractDenominator = 16
For j = 0 To 3
If FractNumerator Mod 2 = 1 Then Exit For
FractNumerator = FractNumerator / 2
FractDenominator = FractDenominator / 2
Next j
If FractNumerator = 0 Then
Fraction = """"
Else
Fraction = FractNumerator & "/" & FractDenominator & """"
End If

ConMet = ConMet & " " & Fraction & " " & "X" & " "
Next i

ConMet = Left(ConMet, Len(ConMet) - 3)

End Function
================================

--ron
 
K

keepITcool

Ron...

Try "100x254x101" on your function below it reutrns:
3 1/1" iso 4"

been doing some testing.. must say your function is very fast..

i reviemwed my own code:
found that TEXT is a member of application.worksheetfunction,
so I can do without the evaluate..
included the " and trimmed the result..
made decimal entry possible... (IF locale has . as decimal)


this is 14% slower then your code but as fast and concise
as I can make it:

Function ConvMM2(Dimensions As String)
Dim i%, v

Const mm2in# = 25.4
On Error GoTo oops:
If IsNumeric(Dimensions) Then
v = Array(Dimensions)
Else
Do
i = i + 1
Loop While IsNumeric(Left(Dimensions, i))
v = Split(Dimensions, Mid(Dimensions, i, 1))
End If

With Application
For i = LBound(v) To UBound(v)
v(i) = .Trim(.Text(v(i) / 25.4, "# ??/16")) & """"
Next
End With
ConvMM2 = Join(v, " X ")
Exit Function
oops:
ConvMM2 = CVErr(xlErrNA)
End Function



Cheerz...



keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >
 
R

Ron Rosenfeld

Ron...

Try "100x254x101" on your function below it reutrns:
3 1/1" iso 4"

been doing some testing.. must say your function is very fast..
Click to expand...

Yes there's a rounding issue there. But this should work:

==================================
Option Explicit
Function ConMet(Val As Range) As String
Dim Dimensions As Variant
Dim i As Integer, j As Integer
Dim FractNumerator As Integer
Dim FractDenominator As Integer
Dim Fraction As String
Dim Sep As String

Const mmPerInch As Double = 25.4

For i = 1 To Len(Val.Text)
Sep = Mid(Val.Text, i, 1)
If Not IsNumeric(Sep) Then Exit For
Next i

If IsNumeric(Sep) Then Sep = ""

Dimensions = Split(Val.Text, Sep, -1)

For i = 0 To UBound(Dimensions)
Dimensions(i) = Round(Dimensions(i) / mmPerInch * 16, 0) / 16
ConMet = ConMet & Int(Dimensions(i))
FractNumerator = 16 * (Dimensions(i) - Int(Dimensions(i)))
FractDenominator = 16
For j = 0 To 3
If FractNumerator Mod 2 = 1 Then Exit For
FractNumerator = FractNumerator / 2
FractDenominator = FractDenominator / 2
Next j
If FractNumerator = 0 Then
Fraction = """"
Else
Fraction = " " & FractNumerator & "/" & FractDenominator & """"
End If

ConMet = ConMet & Fraction & " " & "X" & " "
Next i

ConMet = Left(ConMet, Len(ConMet) - 3)

End Function
===============================
i reviemwed my own code:
found that TEXT is a member of application.worksheetfunction,
so I can do without the evaluate..
included the " and trimmed the result..
made decimal entry possible... (IF locale has . as decimal)


this is 14% slower then your code but as fast and concise
as I can make it:

Function ConvMM2(Dimensions As String)
Dim i%, v

Const mm2in# = 25.4
On Error GoTo oops:
If IsNumeric(Dimensions) Then
v = Array(Dimensions)
Else
Do
i = i + 1
Loop While IsNumeric(Left(Dimensions, i))
v = Split(Dimensions, Mid(Dimensions, i, 1))
End If

With Application
For i = LBound(v) To UBound(v)
v(i) = .Trim(.Text(v(i) / 25.4, "# ??/16")) & """"
Next
End With
ConvMM2 = Join(v, " X ")
Exit Function
oops:
ConvMM2 = CVErr(xlErrNA)
End Function
Click to expand...

That seems to give the correct answer now. Although it does not simplify the
fractions.
--ron
 
R

Ron Rosenfeld

This works but takes to much space

(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"))&""""

Some times the "x" is "*" so need

need Function ConMet(Rrange as range, Xoperator as string)

so in Spreadsheet can just call
=ConMet(B3, x) where x is what ever symbol used as separator


Thanks
Click to expand...

One further correction. There is a rounding problem in my previous solutions.
So this should take care of it:

==========================
Option Explicit
Function ConMet(Val As Range) As String
Dim Dimensions As Variant
Dim i As Integer, j As Integer
Dim FractNumerator As Integer
Dim FractDenominator As Integer
Dim Fraction As String
Dim Sep As String

Const mmPerInch As Double = 25.4

For i = 1 To Len(Val.Text)
Sep = Mid(Val.Text, i, 1)
If Not IsNumeric(Sep) Then Exit For
Next i

If IsNumeric(Sep) Then Sep = ""

Dimensions = Split(Val.Text, Sep, -1)

For i = 0 To UBound(Dimensions)
Dimensions(i) = Round(Dimensions(i) / mmPerInch * 16, 0) / 16
ConMet = ConMet & Int(Dimensions(i))
FractNumerator = 16 * (Dimensions(i) - Int(Dimensions(i)))
FractDenominator = 16
For j = 0 To 3
If FractNumerator Mod 2 = 1 Then Exit For
FractNumerator = FractNumerator / 2
FractDenominator = FractDenominator / 2
Next j
If FractNumerator = 0 Then
Fraction = """"
Else
Fraction = " " & FractNumerator & "/" & FractDenominator & """"
End If

ConMet = ConMet & Fraction & " " & "X" & " "
Next i

ConMet = Left(ConMet, Len(ConMet) - 3)

End Function
====================================

--ron
 
C

Carl Brehm

WOW

Thanks to Ron Rosenfeld and keepitcool

Looks like you both had a blast with this one.

Thank you both, Great Job.

--
Carl Brehm
Lake Lafourche Bird House
Hebert, LA

Keets, Tiels, GN Lories, Quakers
Mitred Conures, TAG's, Bourkes
Lovebirds, Cherry Head Conures
Prince of Whales
 
R

Ron Rosenfeld

WOW

Thanks to Ron Rosenfeld and keepitcool

Looks like you both had a blast with this one.

Thank you both, Great Job.
Click to expand...

You're welcome! Let us know if there are any problems.

Thanks for the feedback.


--ron
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Sumif Help needed 3
.cells help 3
Error 1004 help 4
Range("Weekending").Cells.Columns.Count 4
Formula Help 1
Sumif Function Help 1
sum (column 2 of namedrange) 4
Formula help 3

Top