Macro to add numbers in a text string

[eidde1]

Hi
I hope this someone can help with this

In column G I have a "Total" column Column I has a text string (Heading of "Result" as below

Total Result


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

So basically sometimes the value is missing in the "Total" which is the sumof the numbers in the Results column. I would like some code to add the numbers in the result column and only add it to the total column if no value is entered. So the result would be

Total Result


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

Many thanks for any help

 

[Claus Busch]

Hi,

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

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.

 

[Claus Busch]

Hi again,

Am Fri, 5 Dec 2014 19:13:25 +0100 schrieb Claus Busch:

End If
rngC = No1 + No2 + No3

the lines above are reversed.
Change the code to:

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
rngC = No1 + No2 + No3
End If
Next
End With
End Sub


Regards
Claus B.

 

[Claus Busch]

Hi,

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

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

another suggestion:

Sub myTotal2()
Dim LRow As Long
Dim len1 As Long, len2 As Long, len3 As Long
Dim myStr As String
Dim rngC As Range


With ActiveSheet
LRow = .Cells(Rows.Count, "H").End(xlUp).Row
For Each rngC In Range("G2:G" & LRow)
len1 = 0: len2 = 0: len3 = 0
If Len(rngC) = 0 Then
myStr = rngC.Offset(, 1)
Select Case Len(myStr) - Len(Replace(myStr, " ", ""))
Case 3
len1 = InStr(myStr, " ") + 1
len2 = InStr(len1 + 3, myStr, " ") + 1
rngC = CInt(Mid(myStr, len1, 2)) + CInt(Mid(myStr, len2,
2))
Case 5
len1 = InStr(myStr, " ") + 1
len2 = InStr(len1 + 3, myStr, " ") + 1
len3 = InStr(len2 + 3, myStr, " ") + 1
rngC = CInt(Mid(myStr, len1, 2)) + CInt(Mid(myStr, len2,
2)) _
+ CInt(Mid(myStr, len3, 2))
End Select
End If
Next
End With
End Sub


Regards
Claus B.

 

[Claus Busch]

Hi,

Am Fri, 5 Dec 2014 22:25:34 +0100 schrieb Claus Busch:

Sub myTotal2()

and another suggestion:

Sub myTotal3()
Dim LRow As Long, i 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)
If Len(rngC) = 0 Then
myStr = rngC.Offset(, 1)
For i = 65 To 122
myStr = Replace(myStr, Chr(i), "")
Next
myStr = Replace(Replace(myStr, " ", "+"), " ", "=")
rngC = Evaluate(myStr)
End If
Next
End With
End Sub


Regards
Claus B.

 

[Eddie McCullagh]

Hi Claus
Thank you for all your suggestions. I'm not at work at the moment but will try these suggestions when I get back.
Eddie