Search code examples
excelvbafractions

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

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
enter image description here

Resulting data
enter image description here

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
Solution

  • 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