How to turn general data written as fractions into 3 place decimal numbers. Replace " 0." with "."

Question

I'm trying to turn general data written as fractions like 3/4" or 13 7/32" into 3 place decimal numbers such as 0.750 or 13.219.

I have a working table replacement that handles 0 to 1" fractions. It can't handle the mixed numbers like 13 7/32". It leaves me with 13 0.219 which is why I need to replace " 0." with "." to join the 13 and 219 together with a decimal.

We do this data conversion in multiple steps and hand type because Excel tries converting some fractions like 3/4" into a date.

Original data

Resulting data

Sub FractionConvertMTO()
'this section works
For i = 6 To 70
    Worksheets("BOM").Range("F6:H48").Select
    Selection.Replace what:=Cells(i, 21).Value, Replacement:=Cells(i, 22).Value, _
      LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Next

 'this section doesn't work
For i = 6 To 70
    Worksheets("BOM").Range("F6:H48").Select
    str1 = " "
    str1 = Trim(Replace(str1, " ", "+"))
Next

'this section changes the format.
For i = 66 To 130
    Range("F6:H48").NumberFormat = "0.000"
Next

'this section is supposed to add an = sign in front of the cell contents but doesn't work.
Dim Cell As Range
For Each Cell In Range("F6:H48")
    Cell.Value = "=" & Cell.Value
Next Cell
    
'this section works to highlight the first cell
Worksheets("BOM").Cells(1, 1).Select
       
End Sub

Answer 1

You may also code something like the following:

Sub FractionConvertMTO()
    Dim rng As Range
    Dim Arr As Variant
    Arr = Worksheets("MTO").Range("F6:H48")
    For Row = 1 To UBound(Arr, 1)
        For col = 1 To UBound(Arr, 2)
            str1 = Arr(Row, col)
            pos1 = InStr(str1, " ")
            pos2 = InStr(str1, "/")
            If pos2 = 0 Then
                N = val(str1)
                Num = 0: Den = 1
            Else
                If pos1 And pos1 < pos2 Then
                    N = val(Left$(str1, pos1 - 1))
                    Num = val(Mid$(str1, pos1 + 1))
                Else
                    N = 0
                    Num = val(Left$(str1, pos2 - 1))
                End If
                Den = val(Mid$(str1, pos2 + 1))
            End If
            Arr(Row, col) = N + Num / Den
        Next col
    Next Row
    Worksheets("MTO").Range("F6", "H48") = Arr
End Sub

Answer 2

I dug up the following method from my library of useful functions. It converts numbers represented as a fractional string to the numeric equivalent. Simply loop through the cells needing conversion and call this method:

Public Function FractionToNumber(ByVal Value As String, Optional ByVal Digits As Long = 0) As Double
   Dim P As Integer
   Dim N As Double
   Dim Num As Double
   Dim Den As Double

   Value = Trim$(Value)
   P = InStr(Value, "/")

   If P = 0 Then
      N = Val(Value)
   Else
      Den = Val(Mid$(Value, P + 1))
      Value = Trim$(Left$(Value, P - 1))
      P = InStr(Value, " ")

      If P = 0 Then
         Num = Val(Value)
      Else
         Num = Val(Mid$(Value, P + 1))
         N = Val(Left$(Value, P - 1))
      End If
   End If

   If Den <> 0 Then N = N + Num / Den
   FractionToNumber = Round(N, Digits)
End Function

Answer 3

If you dispose of the newer dynamic array features (vers. 2019+,MS365) you might write the results in one go to the entire original range (target range) as follows (overwriting the existing range; otherwise define a given offset to identify another target range: rng.Offset(,n)=..).

Tip: make a backup copy before testing (as it overwrites rng)!

Note that this example assumes the " character (asc value of 34).

A) First try via tabular VALUE() formula evaluation

Caveat: converting blanks by VALUE() would be written as #VALUE! results, which would need a further loop. To avoid this you can prefix a zero to the formulae myFormula = "=VALUE(SUBSTITUTE(" & """0""&" & rng.Address & ","""""""",""""))" so that results would be displayed as zero.

Sub ChangeToFractionValues()
'1) define original range to be replaced
    Dim rng As Range
    Set rng = ThisWorkbook.Worksheets("BOM").Range("F6:H48")
'2) define tabular formula
    Dim myFormula As String
    'myFormula = "=VALUE(SUBSTITUTE(" & rng.Address & ","""""""",""""))"
    'Alternative to avoid #VALUE! displays for blanks:
    myFormula = "=VALUE(SUBSTITUTE(" & """0""&" & rng.Address & ","""""""",""""))"
    'Debug.Print myFormula
'3) overwrite original range (otherwise code an offset rng.Offset(,n).Value = ...
    rng.Value2 = rng.Parent.Evaluate(myFormula)
End Sub

Conclusion due to comment:

Though fast, this approach has a big disadvantage: Excel interpretes date-like numbers as such, transforms them internally to dates by returning the numeric part here, so a cell input of 3/4" would return the corresponding date value of the current year for March 4th.

---

B) Reworked code based on direct cell evaluations in a loop //Edit

Similar to the above processing this approach is also based on evaluation, but collects all formulae as strings in a variant datafield array v, which allows to manipulate and evaluate each cell input individually:

Sub ChangeToFractionValues()
'1) define original range to be replaced
    Dim rng As Range
    Set rng = ThisWorkbook.Worksheets("BOM").Range("F6:H48")
'2) assign formula strings to variant 1-based 2-dim data field array
    Dim v As Variant
    v = rng.Formula2
'3) evaluate results in a loop
    Dim i As Long, j As Long
    For i = 1 To UBound(v)
        For j = 1 To UBound(v, 2)
            v(i, j) = Evaluate("0" & Replace(v(i, j), Chr(34), ""))
        Next j
    Next i
'4) overwrite original range (otherwise code an offset rng.Offset(,n).Value = ...
    rng.Value = v
End Sub

Answer 4

str1 = trim(Replace(str1, "0.", "."))