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

\$\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\$
    – fionasdad
    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\$
    – fionasdad
    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\$
    – fionasdad
    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, "|"), "Ÿ")
\$\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\$
    – Mark Main
    Commented Apr 1, 2021 at 18:37
0
\$\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
\$\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\$
    – Mark Main
    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

Not the answer you're looking for? Browse other questions tagged or ask your own question.