Count numbers in a string and add numbers together

[AA_20069]

Hi All,

Looking for some help. Not sure if it can be done via a formula or VBA; either way doesn't matter...

So I've got a range starting from O16:V24

each cell is populated like Jack 23, Mark 125, Peter 99, John P 34, Jack 44, Mark 60, Peter 2 etc...

What I need to happen is some Formula/VBA to go through each cell in the range and add up the values next to each name and out put the number next to each name in a different range:

L16 LM16
Jack 67
Mark 185
Peter 101
John P 34

So summing the numbers in the string basically........

[GarysStudent]

Do you want the output pair to be in one cell or two cells ??

[MINCUS1308]

you will have to start by separating the numbers and the text. i'm assuming all the data is contained in a single column? and that 'Jack 67' should have a sum of 13?
you will need to loop through each character in the string and check if it is numeric. if so add it to a rolling sum. at the end of the string, offset to the next line and reset your rolling sum to zero.
Some suto code might look something like




for i=1 to len(string)
if isnumeric(mid(string,i,1)) then
rollingsum=rollingsum+cint(mid(string,i,1))
end if
next i

[MINCUS1308]

Sub test()
For i = 1 To ActiveSheet.UsedRange.Rows.Count
RollingSum = 0
For j = 1 To Len(Cells(i, 1).Text)
If IsNumeric(Mid(Cells(i, 1).Text, j, 1)) Then
RollingSum = RollingSum + CInt(Mid(Cells(i, 1).Text, j, 1))
End If
Cells(i, 2).Value = RollingSum
Next j
Next i
End Sub

[MINCUS1308]

The code above works with this file.13063

[AA_20069]

Do you want the output pair to be in one cell or two cells ??

Preferably in two different cells?

[Yongle]

What the macro does
- takes values from range O16 to V24,
- places alpha element into Sheet2 ColA
- places numeric element into Sheet2 ColB
- uses Excel sub-total on the values in colB (grouping on the name)
- hides non-formula rows
- displays totals by name

You said that the data is in range O16 to V24 - if incorrect, amend the FirstCell and LastCell values.
Before and after screenshots - is this what you wanted?
13066

The workbook is attached, so that you can try it out before incorporating into your workbook.



Sub Remove_Alpha_and_Numerics_and_Summarise()
'declare variables
Dim c As Integer, r As Integer, i As Integer, NumericElement As Integer, lastrow2 As Integer, Lastrow3 As Integer, NameTotal As Integer
Dim StrCell As String, strName As String
Dim NextCellA As Range, NextCellB As Range
Dim FirstCell As Range, LastCell As Range
Dim ws1 As Worksheet, ws2 As Worksheet
'set worksheets and source ranges
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
Set FirstCell = ws1.Range("O16")
Set LastCell = ws1.Range("V24")


'remove old values or old subtotals - only one of these is required
'EITHER
'ws2.Cells.RemoveSubtotal 'removes old-subtotals to allow new values to be added
'OR
ws2.Cells.Delete 'clears all old values from ws2


'create header row
ws2.Range("A1").Value = "Name"
ws2.Range("B1").Value = "Value"


For r = FirstCell.Row To LastCell.Row
For c = FirstCell.Column To LastCell.Column


'extract Alpha into Column A
StrCell = ws1.Cells(r, c).Value
strName = ""
For i = 1 To Len(StrCell)
If (Asc(Mid(StrCell, i, 1)) >= 65 And Asc(Mid(StrCell, i, 1)) <= 90) _
Or ((Asc(Mid(StrCell, i, 1)) >= 97 And Asc(Mid(StrCell, i, 1)) <= 122)) Then
strName = strName & Mid(StrCell, i, 1)
End If
Next i
Set NextCellA = ws2.Range("A1048576").End(xlUp).Offset(1, 0)
NextCellA.Value = strName

'extract Numeric into Column B
StrCell = ws1.Cells(r, c).Value
NumericElement = 0
For i = 1 To Len(StrCell)
If IsNumeric(Mid(StrCell, i, 1)) = True Then
NumericElement = NumericElement & Mid(StrCell, i, 1)
End If
Next i
Set NextCellB = ws2.Range("B1048576").End(xlUp).Offset(1, 0)
NextCellB.Value = NumericElement
Next c
Next r


'summarise by name
lastrow2 = ws2.Range("A1048576").End(xlUp).Row
With ws2
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("A2:A" & lastrow2) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
With ws2.Sort
.SetRange Range("A2:B" & lastrow2)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'use Excel subtotal
ws2.Range("A1:B" & lastrow2).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2) ', Replace:=True, PageBreaks:=False, SummaryBelowData:=True

'Hide the detail, leaving only the subtotals
Lastrow3 = ws2.Range("A1048576").End(xlUp).Offset(-1, 0).Row
For i = 2 To Lastrow3
If ws2.Cells(i, 2).HasFormula = False Then
ws2.Rows(i).Hidden = True
Else
Cells(i, 1).Replace What:=" Total", Replacement:=""
End If
Next i
End Sub

[MINCUS1308]

.

[Yongle]

Where did the thumbsdown comefrom???? oops! :dunno

[Yongle]

@MINCUS1308 (http://www.vbaexpress.com/forum/member.php?53956-MINCUS1308) My code is a little bit fatter than yours!