i wanted to modifiy this code because in my columns rows having fraction values but my few rows in the column having JUST WORDS(String of Characters) as shown in example How Can modify this Please Help me
example : Attribute value1
15/16 IN LG, 1-1/16 IN OD, 11/32 IN THK,21/128 IN ID
19/128 IN LG, 2-3/64 IN OD, 1/2 IN THK, 5/64 IN ID
15/16 IN LG, 1-1/16 IN OD, 11/32 IN THK,21/128 IN ID
19/128 IN LG, 2-3/64 IN OD, 1/2 IN THK, 5/64 IN ID
dsgdsfg ------> see this rows having only characters but no
15/16 IN LG, 1-1/16 IN OD, 11/32 IN THK,21/128 IN ID fraction Values iwant this type of rows should
19/128 IN LG, 2-3/64 IN OD, 1/2 IN THK, 5/64 IN ID be skipped when i run macros it should
sdfadfdfg convert only Fraction values
19/128 IN LG, 2-3/64 IN OD, 1/2 IN THK, 5/64 IN ID
19/128 IN LG, 2-3/64 IN OD, 1/2 IN THK, 5/64 IN ID
19/128 IN LG, 2-3/64 IN OD, 1/2 IN THK, 5/64 IN ID
sdfsadf
15/16 IN LG, 1-1/16 IN OD, 11/32 IN THK,21/128 IN ID
19/128 IN LG, 2-3/64 IN OD, 1/2 IN THK, 5/64 IN ID
15/16 IN LG, 1-1/16 IN OD, 11/32 IN THK,21/128 IN ID
19/128 IN LG, 2-3/64 IN OD, 1/2 IN THK, 5/64 IN ID
sdsdfdfs
15/16 IN LG, 1-1/16 IN OD, 11/32 IN THK,21/128 IN ID
19/128 IN LG, 2-3/64 IN OD, 1/2 IN THK, 5/64 IN ID
15/16 IN LG, 1-1/16 IN OD, 11/32 IN THK,21/128 IN ID
15/16 IN LG, 1-1/16 IN OD, 11/32 IN THK,21/128 IN ID
Sub deci()
Dim LC As Long
Dim Col As Long
Dim LR As Long
Dim Dash As Long
Dim Whole As Double
Dim lngDataColumn As Long
Dim pi
LC = Cells(1, Columns.Count).End(xlToLeft).Column
For Col = 4 To LC Step 2
lngDataColumn = Col
Sheets("Sheet3").Select
LR = Cells(Rows.Count, lngDataColumn).End(xlUp).Row
For r = 2 To LR
s = Cells(r, lngDataColumn)
arr = Split(s, ",")
For i = LBound(arr) To UBound(arr)
Whole = 0
P = InStr(arr(i), " IN")
If P > 0 Then
Worksheet = (Left((arr(i)), P - 1))
Else
Worksheet = arr(i)
End If
Dash = InStr(Worksheet, "-")
If Dash > 0 Then
Whole = Frac(Left(Worksheet, Dash - 1))
Worksheet = Mid(Worksheet, Dash + 1)
End If
af = Right(arr(i), Len(arr(i)) - P + 1)
evfrac = Whole + Left(CStr(Evaluate(Worksheet)), 5)
' evfrac = Whole + Format(Evaluate(frac), "0.###")
ss = ss & evfrac & af & ", "
Next i
Cells(r, lngDataColumn) = Left(ss, Len(ss) - 2)
ss = ""
Next r
Next Col
End Sub
Function Frac(ByVal X As String) As Double
Dim P As Integer, N As Double, Num As Double, Den As Double
X = Trim$(X)
P = InStr(X, "/")
If P = 0 Then
N = Val(X)
Else
Den = Val(Mid$(X, P + 1))
If Den = 0 Then Err.Raise 11 ' Divide by zero
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
Frac = N
End Function
Bookmarks