Hi,

Am Fri, 5 Dec 2014 09:10:04 -0800 (PST) schrieb :

Total Result


25 Apples 10 Oranges 3 Grapes 12
15 Melons 10 Grapes 5
26 Oranges 8 Grapes 18

try:

Sub myTotal()
Dim LRow As Long, mySum As Long, i As Long
Dim No1 As Long, No2 As Long, No3 As Long
Dim rngC As Range
Dim myStr As String

With ActiveSheet
LRow = .Cells(Rows.Count, "H").End(xlUp).Row
For Each rngC In Range("G2:G" & LRow)
No1 = 0: No2 = 0: No3 = 0
If Len(rngC) = 0 Then
myStr = rngC.Offset(, 1)
For i = 65 To 122
myStr = Replace(myStr, Chr(i), "")
Next
Select Case Len(myStr) - Len(Replace(myStr, " ", ""))
Case 3
No1 = Left(myStr, InStr(2, myStr, " ") - 1)
No2 = Mid(myStr, InStr(2, myStr, " ") + 2)
Case 5
No1 = Left(myStr, InStr(2, myStr, " ") - 1)
No2 = Mid(myStr, InStr(3, myStr, " ") + 1, 2)
No3 = Mid(myStr, InStrRev(myStr, " ") + 1)
End Select
End If
rngC = No1 + No2 + No3
Next
End With
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional