4
\$\begingroup\$

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

asked Jan 13, 2021 at 18:27
\$\endgroup\$
10
  • \$\begingroup\$ These look like they are to be used as User Defined Functions called from worksheet formulas. You should strive to use VBA-only code. Punching through the barrier from VBA to Excel to access worksheet functions (i.e. WorksheetFunction.Substitute()) is SLOW. What is wrong with VBA's Replace() function? \$\endgroup\$ Commented Jan 13, 2021 at 18:55
  • \$\begingroup\$ FYI VBA has Replace() which does the same thing as WorksheetFunction.Substitute and is a little faster. \$\endgroup\$ Commented Jan 13, 2021 at 18:56
  • 1
    \$\begingroup\$ @TimWilliams Replace() is a LOT faster. Every call through the VBA-to-Excel divide is extremely expensive. \$\endgroup\$ Commented Jan 13, 2021 at 18:59
  • \$\begingroup\$ Dim feet, inches, inch, rInt, rGcd As Long Do you realize that ONLY rGcd 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 a Dim statement must be typed INDIVIDUALLY. When a type is omitted for a given variable, it defaults to Variant. \$\endgroup\$ Commented Jan 13, 2021 at 19:04
  • \$\begingroup\$ @ExcelHero - I saw Replace as about 3x faster in a quick test. \$\endgroup\$ Commented Jan 13, 2021 at 19:12

2 Answers 2

8
\$\begingroup\$

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, "|"), "Ÿ")
answered Jan 13, 2021 at 19:11
\$\endgroup\$
1
  • \$\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\$ Commented Apr 1, 2021 at 18:37
1
\$\begingroup\$

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
answered Apr 1, 2021 at 20:21
\$\endgroup\$
2
  • 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\$ Commented 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\$ Commented Apr 2, 2021 at 6:48

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.