STR2INCHES is an Excel VBA Function that will convert string text for Imperial length measurements to a decimal number of Inches.
It handles both English and Spanish words, abbreviations and symbols for yards, feet and inches. Dashes are treated like they are spaces, and so it just does not care where dashes are used or not, except a dash on the far left side is considered as a negative number. Negative numbers can be denoted with either a dash on the far left side or enclosing the entire string inside parentheses ().
IMPTEXT is an Excel VBA Function that will convert string text of Imperial lengths (see above) or a decimal number of inches to formatted text of Feet and Inches.
Divisor is the 2nd parameter, its optional defaulting to 8 for 8ths of an inch. Measures are rounded to this divisor. Typical numbers would be 8 or 16, however, 2 and 4 or perhaps 10, 100 or 1000, could be possibilities, all are acceptable.
appxInd is the 3rd parameter, it's optional defaulting to True; when True it will display a single tilde ~ when rounding is less than the actual value displayed, and a double tilde when rounding is greater than the actual value displayed. False will not display this approximation indicator.
CODE
Option Explicit
Function STR2INCHES(ByVal measurement As Variant) As Variant
'STR2INCHES converts Imperial feet and inch measurement text to decimal inches.
'A dash on the left or left and right parentheses are used for negative values.
'Any cammas are ignored, so don't worry about them if they are present.
'Inches denoted by double-quotes or Inches, or Inch, or In.
'Feet denoted by single-quote or Feet, or Foot, or Ft.
'Periods on the end are ignored.
'Not case-sensitive.
'Returns a decimal value for converted inches.
'Return is Variant and so it is compatable with different variable type.
'Return #VALUE! when conversion error occurs.
Dim negVal As Boolean
Dim i, unitPos As Long
On Error GoTo STR2INCHESerr
'Remove all commas
measurement = WorksheetFunction.Substitute(measurement, ",", "")
'Remove trailing periods and trim
measurement = Trim(LCase(measurement))
Do While Right(measurement, 1) = "."
measurement = Trim(Left(measurement, Len(measurement) - 1))
Loop
'check if negative value. e.g. left dash or ()
If Left(measurement, 1) = "-" Then
negVal = True
measurement = Mid(measurement, 2, 9999)
Else
If Left(measurement, 1) = "(" Then
If Right(measurement, 1) = ")" Then
negVal = True
measurement = Trim(Mid(measurement, 2, Len(measurement) - 2))
End If
End If
End If
'convert yards text to Ÿ
measurement = WorksheetFunction.Substitute(measurement, "yardas", "Ÿ") 'Spanish
measurement = WorksheetFunction.Substitute(measurement, "yarda", "Ÿ")
measurement = WorksheetFunction.Substitute(measurement, "yards", "Ÿ") 'English
measurement = WorksheetFunction.Substitute(measurement, "yard", "Ÿ")
measurement = WorksheetFunction.Substitute(measurement, "yds.", "Ÿ")
measurement = WorksheetFunction.Substitute(measurement, "yds", "Ÿ")
measurement = WorksheetFunction.Substitute(measurement, "yd.", "Ÿ")
measurement = WorksheetFunction.Substitute(measurement, "yd", "Ÿ")
Do While InStr(measurement, " Ÿ") > 0
measurement = WorksheetFunction.Substitute(measurement, " Ÿ", "Ÿ")
Loop
'convert feet text to single-quote '
measurement = WorksheetFunction.Substitute(measurement, "feet", "'") 'English
measurement = WorksheetFunction.Substitute(measurement, "foot", "'")
measurement = WorksheetFunction.Substitute(measurement, "ft.", "'")
measurement = WorksheetFunction.Substitute(measurement, "ft", "'")
measurement = WorksheetFunction.Substitute(measurement, "pies", "'") 'Spanish
measurement = WorksheetFunction.Substitute(measurement, "píes", "'")
measurement = WorksheetFunction.Substitute(measurement, "piés", "'")
measurement = WorksheetFunction.Substitute(measurement, "pie", "'")
measurement = WorksheetFunction.Substitute(measurement, "pié", "'")
Do While InStr(measurement, " '") > 0
measurement = WorksheetFunction.Substitute(measurement, " '", "'")
Loop
'convert inch text to double-quotes "
measurement = WorksheetFunction.Substitute(measurement, "inches", """") 'English
measurement = WorksheetFunction.Substitute(measurement, "inch", """")
measurement = WorksheetFunction.Substitute(measurement, "in.", """")
measurement = WorksheetFunction.Substitute(measurement, "in", """")
measurement = WorksheetFunction.Substitute(measurement, "pulgadas", """") 'Spanish
measurement = WorksheetFunction.Substitute(measurement, "pulgada", """")
Do While InStr(measurement, " """) > 0
measurement = WorksheetFunction.Substitute(measurement, " """, """")
Loop
'get rid of any dash
measurement = WorksheetFunction.Substitute(measurement, "-", " ")
'ensure measurement symbols are followed by a blank
measurement = Trim(WorksheetFunction.Substitute(measurement, """", """ "))
measurement = Trim(WorksheetFunction.Substitute(measurement, "'", "' "))
measurement = Trim(WorksheetFunction.Substitute(measurement, "Ÿ", "Ÿ "))
'convert double blanks to single blanks
Do While InStr(measurement, " ") > 0
measurement = WorksheetFunction.Substitute(measurement, " ", " ")
Loop
'Default to Inches if nothing else is found
measurement = Trim(measurement)
If Right(measurement, 1) <> """" Then
If Right(measurement, 1) <> "'" Then
If Right(measurement, 1) <> "Ÿ" Then
measurement = measurement & """"
End If
End If
End If
'measurement now in standard format, so convert it to inches
' e.g. 2Ÿ 1' 3.25" or 2Ÿ 1' 3 1/4" or 15 1/4" or 15.25"
'evaluate converts fractions and decimal text to decimal
STR2INCHES = getValue(measurement, "Ÿ") * 36 'Yards
STR2INCHES = STR2INCHES + getValue(measurement, "'") * 12 'Feet
STR2INCHES = STR2INCHES + getValue(measurement, """") 'Inches
If negVal Then STR2INCHES = -STR2INCHES 'Flip to negative applicable
Exit Function
STR2INCHESerr:
STR2INCHES = CVErr(xlErrValue) 'return #VALUE! error
On Error GoTo 0
End Function
Function getValue(ByVal measurement As Variant, ByVal unitDelim As Variant) As Variant
'this will find and return a whole number, decimal numbers and whole numbers with a fraction
'it starts with finding the unitDelim and working backwards
Dim unitPos, i As Long
On Error GoTo getValueErr
unitPos = InStr(measurement, unitDelim)
If unitPos > 0 Then
i = InStrRev(measurement, " ", unitPos) - 1
'search backwards for any character not related to numbers and blanks
Do Until i <= 0
If IsNumeric(Mid(measurement, i, 1)) Or Mid(measurement, i, 1) = "." Or Mid(measurement, i, 1) = " " Then
i = i - 1
Else
Exit Do
End If
DoEvents
Loop
i = i + 1
If i <= 0 Then i = 1
getValue = Evaluate(Mid(measurement, i, unitPos - i))
End If
Exit Function
getValueErr:
getValue = CVErr(xlErrValue) 'return #VALUE! error
On Error GoTo 0
End Function
Function IMPTEXT(ByVal measurement As Variant, Optional ByVal divisor As Variant = 8, Optional ByVal appxInd As Boolean = True) As String
'IMPTEXT will format a decimal number of inches to text using Imperial Yards, Feet and Inch measurements
'will round round inches value to nearest divisor (default is 8ths),
'then returns a formatted text string of feet inches and fractional inches.
'Important: rounding up or down is reversed for negative numbers.
'Return #VALUE! when conversion error occurs.
'Optional divisor:
' Default is 8ths, however you may optionally round to whole numbers(1), halfs(2), quarters(4), tenths(10), sixteenths(16), (32)...
'Optional appxInd (default is True):
' approximation symbols are reverse order for negative numbers.
' Will optionally add single-tilde approximation symbol if rounded value displayed is less than actual size.
' Will optionally add double-tilde approximation symbol if rounded value displayed is more than actual size.
Dim feet, inches, inch, rInt, rGcd As Long
Dim inchDecimal, rNum, appx As Double
Dim inchPos As Boolean
On Error GoTo IMPTEXTerr
divisor = Round(divisor, 0) 'to ensure whole numbers
inches = STR2INCHES(measurement) 'convert to decimal if needed
If inches < 0 Then
inchPos = True
inches = Abs(inches)
End If
feet = Int(inches / 12)
inch = Int(inches - feet * 12)
inchDecimal = inches - feet * 12 - inch
rNum = inchDecimal * divisor
rInt = Round(rNum, 0)
appx = rNum - rInt
If feet > 0 Then IMPTEXT = feet & "' "
IMPTEXT = IMPTEXT & inch
If rInt > 0 Then
If inch > 0 Then
IMPTEXT = IMPTEXT & "-"
Else
IMPTEXT = IMPTEXT & " "
End If
rGcd = WorksheetFunction.Gcd(rInt, divisor)
IMPTEXT = IMPTEXT & rInt / rGcd & "/" & divisor / rGcd
End If
IMPTEXT = Trim(IMPTEXT) & """"
IMPTEXT = Trim(IMPTEXT)
If inchPos Then
IMPTEXT = "(" & IMPTEXT & ")"
End If
If appxInd Then
If appx < 0 Then
IMPTEXT = "~" & IMPTEXT 'approx is slightly less than shown
ElseIf appx > 0 Then
IMPTEXT = ChrW(&H2248) & " " & IMPTEXT 'approx is slighly greater than shown
End If
End If
Exit Function
IMPTEXTerr:
IMPTEXT = CVErr(xlErrValue) 'return #VALUE! error
On Error GoTo 0
End Function
IMPORTANT NOTE: THE CODE ABOVE WORKS, BUT I MODIFIED A BETTER VERSION AND POSTED IT AT THE BOTTOM AS A COMMENT IN THIS POSTING. PLEASE USE THE CODE BELOW NOT THIS CODE ABOVE.
It's very robust code that handles every reasonable variation of decimal and fractional values with Spanish and English notations of Yards, Feet and Inches. Let me know if you have any suggestions; I always welcome kind feedback.
An example use is:
=str2inches(A1)
STR2INCHES(A1) offers more flexibility than other code that I have personally seen and tested. It's also bilingual and so it handles yards (yardas), feet (píes), inches (pulgadas), symbols, and measurement abbreviations. It does not assume any particular sequence of certain measures, it will use the first measure found of each type. It handles fractions and decimals and is forgiving with no spaces, single and double spaces. e.g. 5.25In vs. 5-1/4" vs. 5 1/4 Inches vs. 5 1/4pulgadas would all return 5.25
It also formats to a standard format of Feet and Inches.
=IMPTEXT(A1, 16, FALSE)
The first parameter is expecting Inches, but it will convert to inches using STR2INCHES automatically if needed.
It always rounds to the nearest divisor (in the example above it would round to 16ths; rounding to 8ths is the default.
It defaults to displaying a single tilde ~ if rounding displays a value that is less than the actual value, and displays a double tilde when the displayed value is greater than the actual value.
It handles negative numbers fine, it displays them using parenthesis ().
2 Answers 2
This pattern shows up multiple times:
'convert yards text to Ÿ
measurement = WorksheetFunction.Substitute(measurement, "yardas", "Ÿ") 'Spanish
measurement = WorksheetFunction.Substitute(measurement, "yarda", "Ÿ")
measurement = WorksheetFunction.Substitute(measurement, "yards", "Ÿ") 'English
measurement = WorksheetFunction.Substitute(measurement, "yard", "Ÿ")
measurement = WorksheetFunction.Substitute(measurement, "yds.", "Ÿ")
measurement = WorksheetFunction.Substitute(measurement, "yds", "Ÿ")
measurement = WorksheetFunction.Substitute(measurement, "yd.", "Ÿ")
measurement = WorksheetFunction.Substitute(measurement, "yd", "Ÿ")
Do While InStr(measurement, " Ÿ") > 0
measurement = WorksheetFunction.Substitute(measurement, " Ÿ", "Ÿ")
Loop
and is a good candidate for refactoring into a standalone helper function:
Function NormalizeUnits(ByVal txt As String, oldUnits, newUnit As String) As String
Dim u
For Each u In oldUnits
txt = Replace(txt, u, newUnit)
Next u
Do While InStr(txt, " " & newUnit) > 0
txt = Replace(txt, " " & newUnit, newUnit)
Loop
NormalizeUnits = txt
End Function
Example call:
Const YARDS As String = "yardas|yarda|yards|yard|yds.|yds|yd.|yd"
'...
'...
measurement = NormalizeUnits(measurement, Split(YARDS, "|"), "Ÿ")
-
\$\begingroup\$ Tim, I like your improvement. It will tidy the code up, thanks for taking the time and writing it up. I will repost a reply with the cleaner code. \$\endgroup\$Mark Main– Mark Main2021年04月01日 18:37:24 +00:00Commented Apr 1, 2021 at 18:37
I updated my code based on the suggestions provided and also modified the code to allow multiple uses of the same unit of measure (it will just add the values).
Thank you to everyone for the kind suggestions. This code is better for it.
Option Explicit
Public Function STR2INCHES(ByVal measurement As Variant) As Variant
'STR2INCHES converts Imperial feet and inch measurement text to decimal inches.
'A dash on the left or left and right parentheses are used for negative values.
'Any commas are ignored, so don't worry about them if they are present.
'Inches denoted by double-quotes or Inches, or Inch, or In.
'Feet denoted by single-quote or Feet, or Foot, or Ft.
'Periods on the end are ignored.
'Not case-sensitive.
'Returns a decimal value for converted inches.
'Return is Variant and so it is compatible with different variable type.
'Return #VALUE! when conversion error occurs.
Dim negVal As Boolean
Dim i As Long
Dim unitPos As Long
Const YARDS As String = "yardas|yarda|yards|yard|yds.|yds|yd.|yd" 'English and Spanish YARD terms
Const FEET As String = "feet|foot|ft.|ft|pies|píes|piés|pie|pié" 'English and Spanish FEET terms
Const INCHES As String = "inches|inch|in.|in|pulgadas|pulgada" 'English and Spanish INCH terms
On Error GoTo STR2INCHESerr
'Remove all commas
measurement = Replace(measurement, ",", "")
'Remove trailing periods and trim
measurement = Trim(LCase(measurement))
Do While Right(measurement, 1) = "."
measurement = Trim(Left(measurement, Len(measurement) - 1))
Loop
'check if negative value. e.g. left dash or ()
If Left(measurement, 1) = "-" Then
negVal = True
measurement = Mid(measurement, 2, 9999)
Else
If Left(measurement, 1) = "(" Then
If Right(measurement, 1) = ")" Then
negVal = True
measurement = Trim(Mid(measurement, 2, Len(measurement) - 2))
End If
End If
End If
measurement = NormalizeUnits(measurement, Split(YARDS, "|"), "Ÿ") 'convert yards text to Ÿ
measurement = NormalizeUnits(measurement, Split(FEET, "|"), "'") 'convert feet text to single-quote '
measurement = NormalizeUnits(measurement, Split(INCHES, "|"), """") 'convert inch text to double-quotes "
measurement = Replace(measurement, "-", " ") 'get rid of any dash
'ensure measurement symbols are followed by a blank
measurement = Trim(Replace(measurement, """", """ "))
measurement = Trim(Replace(measurement, "'", "' "))
measurement = Trim(Replace(measurement, "Ÿ", "Ÿ "))
'convert double blanks to single blanks
Do While InStr(measurement, " ") > 0
measurement = Replace(measurement, " ", " ")
Loop
'Default to Inches if nothing else is found
measurement = Trim(measurement)
If Right(measurement, 1) <> """" Then
If Right(measurement, 1) <> "'" Then
If Right(measurement, 1) <> "Ÿ" Then
measurement = measurement & """"
End If
End If
End If
'measurement now in standard format, so convert it to inches
' e.g. 2Ÿ 1' 3.25" or 2Ÿ 1' 3 1/4" or 15 1/4" or 15.25"
'evaluate converts fractions and decimal text to decimal
STR2INCHES = GetValue(measurement, "Ÿ") * 36 'Yards
STR2INCHES = STR2INCHES + GetValue(measurement, "'") * 12 'Feet
STR2INCHES = STR2INCHES + GetValue(measurement, """") 'Inches
If negVal Then STR2INCHES = -STR2INCHES 'Flip to negative applicable
Exit Function
STR2INCHESerr:
STR2INCHES = CVErr(xlErrValue) 'return #VALUE! error
On Error GoTo 0
End Function
Private Function GetValue(ByVal measurement As Variant, ByVal unitDelim As Variant) As Variant
'this will find and return a whole number, decimal numbers and whole numbers with a fraction
'it starts with finding the unitDelim and working backwards
'it will also add multiple representations of the same unit. e.g. 2Yds 3Yards would return 5 Yards
Dim unitPos As Long
Dim i As Long
On Error GoTo getValueErr
unitPos = InStr(measurement, unitDelim)
Do While unitPos > 0
i = InStrRev(measurement, " ", unitPos) - 1
'search backwards for any character not related to numbers and blanks
Do Until i <= 0
If IsNumeric(Mid(measurement, i, 1)) Or Mid(measurement, i, 1) = "." Or Mid(measurement, i, 1) = " " Then
i = i - 1
Else
Exit Do
End If
DoEvents
Loop
i = i + 1
If i <= 0 Then i = 1
GetValue = GetValue + Evaluate(Mid(measurement, i, unitPos - i))
unitPos = InStr(unitPos + 1, measurement, unitDelim)
Loop
Exit Function
getValueErr:
GetValue = CVErr(xlErrValue) 'return #VALUE! error
On Error GoTo 0
End Function
Public Function IMPTEXT(ByVal measurement As Variant, Optional ByVal divisor As Variant = 8, Optional ByVal appxInd As Boolean = True) As String
'IMPTEXT will format a decimal number of inches to text using Imperial Yards, Feet and Inch measurements
'will round inches value to nearest divisor (default is 8ths),
'then returns a formatted text string of feet inches and fractional inches.
'Important: rounding up or down is reversed for negative numbers.
'Return #VALUE! when conversion error occurs.
'Optional divisor:
' Default is 8ths, however you may optionally round to whole numbers(1), halfs(2), quarters(4), tenths(10), sixteenths(16), (32)...
'Optional appxInd (default is True):
' approximation symbols are reverse order for negative numbers.
' Will optionally add single-tilde approximation symbol if rounded value displayed is less than actual size.
' Will optionally add double-tilde approximation symbol if rounded value displayed is more than actual size.
Dim inchPos As Boolean
Dim inches As Double
Dim inchDecimal As Double
Dim inch As Long
Dim feet As Long
Dim rInt As Long
Dim rGcd As Long
Dim rNum As Double
Dim appx As Double
On Error GoTo IMPTEXTerr
divisor = Round(divisor, 0) 'to ensure whole numbers
inches = STR2INCHES(measurement) 'convert to decimal if needed
If inches < 0 Then
inchPos = True
inches = Abs(inches)
End If
feet = Int(inches / 12)
inch = Int(inches - feet * 12)
inchDecimal = inches - feet * 12 - inch
rNum = inchDecimal * divisor
rInt = Round(rNum, 0)
appx = rNum - rInt
If feet > 0 Then IMPTEXT = feet & "' "
IMPTEXT = IMPTEXT & inch
If rInt > 0 Then
If inch > 0 Then
IMPTEXT = IMPTEXT & "-"
Else
IMPTEXT = IMPTEXT & " "
End If
rGcd = WorksheetFunction.Gcd(rInt, divisor)
IMPTEXT = IMPTEXT & rInt / rGcd & "/" & divisor / rGcd
End If
IMPTEXT = Trim(IMPTEXT) & """"
IMPTEXT = Trim(IMPTEXT)
If inchPos Then
IMPTEXT = "(" & IMPTEXT & ")"
End If
If appxInd Then
If appx < 0 Then
IMPTEXT = "~" & IMPTEXT 'approx is slightly less than shown
ElseIf appx > 0 Then
IMPTEXT = ChrW(&H2248) & " " & IMPTEXT 'approx is slightly greater than shown
End If
End If
Exit Function
IMPTEXTerr:
IMPTEXT = CVErr(xlErrValue) 'return #VALUE! error
On Error GoTo 0
End Function
Private Function NormalizeUnits(ByVal txt As String, oldUnits, newUnit As String) As String
'Converts various oldUnits within txt into a single standard newUnit
Dim oldUnit As Variant
For Each oldUnit In oldUnits
txt = Replace(txt, oldUnit, newUnit)
Next oldUnit
Do While InStr(txt, " " & newUnit) > 0
txt = Replace(txt, " " & newUnit, newUnit) 'remove leading spaces
Loop
NormalizeUnits = txt
End Function
-
1\$\begingroup\$ I created this code to be very robust, it can handle most any reasonable imperial measurement variation of yards, feet, inches and fractions that you can throw at it. it also handles Spanish and English words. If someone finds an error please let me know so i can try to debug the code. I believe this to be tested working code. \$\endgroup\$Mark Main– Mark Main2021年04月01日 21:21:15 +00:00Commented Apr 1, 2021 at 21:21
-
\$\begingroup\$ If you want further suggestions on the new code, I recommend you post it as a new question, with a link to this one. OTOH, if you just want bug reports and not reviews, then you've done the right thing. :) \$\endgroup\$Toby Speight– Toby Speight2021年04月02日 06:48:10 +00:00Commented Apr 2, 2021 at 6:48
WorksheetFunction.Substitute()
) is SLOW. What is wrong with VBA'sReplace()
function? \$\endgroup\$Replace()
which does the same thing asWorksheetFunction.Substitute
and is a little faster. \$\endgroup\$Replace()
is a LOT faster. Every call through the VBA-to-Excel divide is extremely expensive. \$\endgroup\$Dim feet, inches, inch, rInt, rGcd As Long
Do you realize that ONLYrGcd
is a Long here? All the other variables declared with this statement are Variants. You seem to use this style of coding a lot... and it does not result in what you think it does. Every single variable included in aDim
statement must be typed INDIVIDUALLY. When a type is omitted for a given variable, it defaults to Variant. \$\endgroup\$Replace
as about 3x faster in a quick test. \$\endgroup\$