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 ().
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\$