How to convert Feet and Inches-String to inches only, using VBA ?

Pramodpandit123

New Member
Joined
Apr 18, 2020
Messages
30
Office Version
  1. 2016
Platform
  1. Windows
I have Feet and Inches -string in format like 3'-9" , 6" ,12'-11" etc. How can i convert these string values to inches only using VBA .
The string may contain inches only(6") or both feet and inches(12'-11").
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
Does it have to be VBA ? If a formula is OK then try

=IFERROR(LEFT(A1,FIND("'",A1)-1)*12,0)+SUBSTITUTE(SUBSTITUTE(RIGHT(A1,3),"-",""),"""","")
 
Upvote 0
Perhaps these code will help:
VBA Code:
''#################################################################
''## 7 Functions to deal with feet-inches format in Excel        ##
''## in form of [#'-#"] or [#'-# #/##"] or [#'-#.##"]            ##
''## By Phh, 2010, last update 6/26/2022                         ##
''## Functions update to work with negative feet-inches          ##
''#################################################################
''## todec()     Convert to decimal                              ##
''## toimpe()    Convert to imperial, engineering format         ##
''##             with optional precision argument, default 1/16" ##
''## toimpa()    Convert to imperial, architectural format       ##
''##             with optional precision argument, default 1/16" ##
''## sumtodec()  Similar to SUM function, decimal format         ##
''## sumtoimpe() Similar to SUM function, engineering format     ##
''## sumtoimpa() Similar to SUM function, architectural format   ##
''## frac2num()  Sub function, convert fraction to decimal       ##
''#################################################################

Option Explicit

Public Function todec(strX As String) As Double
  Dim startPos, ftPos, frPos, signofNum As Integer
  Dim rdLen As Double
  strX = Trim$(strX)
  If Left$(strX, 1) = "-" Then
    signofNum = -1
  Else
    signofNum = 1
  End If
  strX = Replace(Replace(strX, """", ""), "-", "")
  startPos = 1
  ftPos = InStr(startPos, strX, "'")
  frPos = InStr(startPos, strX, "/")
  If ftPos = 0 And frPos = 0 Then
    todec = Val(strX) * signofNum
    Exit Function
  End If
  If ftPos = 0 And frPos > 0 Then
    todec = frac2num(strX) * signofNum
    Exit Function
  End If
  rdLen = CDbl(Left$(strX, ftPos - 1)) * 12
  If frPos = 0 Then
    rdLen = rdLen + (Val(Mid$(strX, ftPos + 1, Len(strX))))
    todec = rdLen * signofNum
    Exit Function
  End If
  rdLen = rdLen + frac2num(Mid$(strX, ftPos + 1, Len(strX)))
  todec = rdLen * signofNum
End Function

Public Function toimpe(rawLen As Double, Optional argRd As Variant = 16) As String
 Dim rdLen As Double, argRdNum As Double
 If argRd >= 1 Then
   argRdNum = 1 / Fix(argRd)
    rdLen = Excel.WorksheetFunction.Round(rawLen / argRdNum, 0) * argRdNum
 ElseIf argRd < 1 And argRd > 0 Then
   argRdNum = argRd
    rdLen = Excel.WorksheetFunction.Round(rawLen / argRdNum, 0) * argRdNum
 Else
    rdLen = rawLen
 End If
 If Abs(Excel.WorksheetFunction.Round(rawLen / argRdNum, 0)) < Abs(argRdNum) Then
    toimpe = "0"""
    Exit Function
 End If
 If rdLen <= -12 Or rdLen >= 12 Then
    toimpe = (Fix(rdLen / 12)) & "'-" & Abs(rdLen - (12 * Fix(rdLen / 12))) & """"
 ElseIf rdLen < 12 And rdLen > -12 Then
      toimpe = rdLen & """"
 End If
End Function

Public Function toimpa(rawLen As Double, Optional argRd As Variant = 16) As String
 Dim rdLen As Double, argRdNum As Double
 If argRd >= 1 Then
   argRdNum = 1 / Fix(argRd)
    rdLen = Excel.WorksheetFunction.Round(rawLen / argRdNum, 0) * argRdNum
 ElseIf argRd < 1 And argRd > 0 Then
   argRdNum = argRd
    rdLen = Excel.WorksheetFunction.Round(rawLen / argRdNum, 0) * argRdNum
 Else
    rdLen = rawLen
 End If
 If Abs(Excel.WorksheetFunction.Round(rawLen / argRdNum, 0)) < Abs(argRdNum) Then
    toimpa = "0"""
    Exit Function
 End If
 If rdLen <= -12 Or rdLen >= 12 Then
    toimpa = (Fix(rdLen / 12)) & "'-" & Excel.WorksheetFunction.Text(Abs(rdLen - (12 * Fix(rdLen / 12))), "0 ##/####") & """"
 ElseIf rdLen < 12 And rdLen > -12 Then
    If (rdLen - Fix(rdLen)) = 0 Then
      toimpa = rdLen & """"
    Else
      toimpa = Excel.WorksheetFunction.Text(rdLen, "# ###/###") & """"
    End If
 End If
End Function

Public Function sumtodec(ParamArray Xrange() As Variant) As Double
  Dim sumArray As Double
  Dim theVal As Variant
  Dim I As Integer
  For I = LBound(Xrange) To UBound(Xrange)
   If TypeOf Xrange(I) Is Range Then
   For Each theVal In Xrange(I)
    sumArray = sumArray + todec(CStr(theVal))
   Next theVal
   Else
    sumArray = sumArray + CDbl(Xrange(I))
   End If
  Next
  sumtodec = sumArray
End Function

Public Function sumtoimpe(ParamArray Xrange() As Variant) As String
  Dim sumArray As Double, argRdNum As Double
  Dim theVal As Variant
  Dim I As Integer
  For I = LBound(Xrange) To UBound(Xrange)
   If TypeOf Xrange(I) Is Range Then
   For Each theVal In Xrange(I)
    sumArray = sumArray + todec(CStr(theVal))
   Next theVal
   Else
    sumArray = sumArray + CDbl(Xrange(I))
   End If
  Next
  ''#######################################################################
  ''## Set precision round-off to 1/512" as default, change if required! ##
  ''#######################################################################
  argRdNum = (1 / 512)
  sumArray = Excel.WorksheetFunction.Round(sumArray / argRdNum, 0) * argRdNum
  If sumArray <= -12 Or sumArray >= 12 Then
    sumtoimpe = (Fix(sumArray / 12)) & "'-" & Abs(sumArray - (12 * Fix(sumArray / 12))) & """"
  ElseIf sumArray < 12 And sumArray > -12 Then
    sumtoimpe = sumArray & """"
  End If
End Function

Public Function sumtoimpa(ParamArray Xrange() As Variant) As String
  Dim sumArray As Double, argRdNum As Double
  Dim theVal As Variant
  Dim I As Integer
  For I = LBound(Xrange) To UBound(Xrange)
   If TypeOf Xrange(I) Is Range Then
   For Each theVal In Xrange(I)
    sumArray = sumArray + todec(CStr(theVal))
   Next theVal
   Else
    sumArray = sumArray + CDbl(Xrange(I))
   End If
  Next
  ''#######################################################################
  ''## Set precision round-off to 1/512" as default, change if required! ##
  ''#######################################################################
  argRdNum = (1 / 512)
  sumArray = Excel.WorksheetFunction.Round(sumArray / argRdNum, 0) * argRdNum
  If sumArray <= -12 Or sumArray >= 12 Then
    sumtoimpa = (Fix(sumArray / 12)) & "'-" & Excel.WorksheetFunction.Text(Abs(sumArray - (12 * Fix(sumArray / 12))), "0 ##/####") & """"
  ElseIf sumArray < 12 And sumArray > -12 Then
    If (sumArray - Fix(sumArray)) = 0 Then
      sumtoimpa = sumArray & """"
    Else
      sumtoimpa = Excel.WorksheetFunction.Text(sumArray, "# ###/###") & """"
    End If
 End If
End Function

Function frac2num(ByVal X As String) As Double
  Dim P As Integer
  Dim N As Double, Num As Double, Den As Double
  X = (X)
  P = InStr(X, "/")
  If P = 0 Then
    N = Val(X)
  Else
    Den = Val(Mid$(X, P + 1))
    If Den = 0 Then Error 11
      X = Trim$(Left$(X, P - 1))
      P = InStr(X, " ")
    If P = 0 Then
      Num = Val(X)
    Else
      Num = Val(Mid$(X, P + 1))
      N = Val(Left$(X, P - 1))
    End If
  End If
  If Den <> 0 Then
    N = N + Num / Den
  End If
  frac2num = N
End Function

Cheer!

Phh
 
Upvote 0
FuncDes.PNG


Some descriptions

Phh
 
Upvote 0

Forum statistics

Threads
1,223,904
Messages
6,175,295
Members
452,633
Latest member
DougMo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top