sum specific cells with a condition - vba - vba

Question

I want to sum the numbers from E column for each name and put the result in column F. I mean:
(Sheet1)
colA-Name: colE-Number:
row1: Michael 16
row2: Michael 20
row3: Andrew 15
row4: Edward 19
row5: Edward 13
row6: Edward 24
row7: Helen 17
And I want something like this:
colA-Name: colF-SUM:
row1: Michael 36
row2: Michael
row3: Andrew 15
row4: Edward 56
row5: Edward
row6: Edward
row7: Helen 17
Here is my code so far but doesn't work.
Sub sum()
Dim Rng As Range
Dim cel As Range
Dim lastRowA As Long
Dim myRange As Range
Dim myString As String
lastRowA = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Sheets("Sheet1").Range("A2:A" & lastRowA)
Set cel = Sheets("Sheet1").Range("A:A")
'find duplicates name in column A
Set myRange = Sheets("Sheet1").Range("A2:A" & lastRowA).Find(What:=myString, LookAt:=xlPart)
For Each cel In Rng
'if founded, sum their numbers and put it in F column
If Not myRange Is Nothing Then
cel.Offset(0, 5) = cel.Offset(0, 4).Value + cel.Offset(1, 4).Value
'Range("F:F").Value = cel.Offset(0, 4).Value + cel.Offset(1, 4).Value
End If
Next
End Sub
Is anyone able to help? Thanks!

Answer 1

You could use a simple excel formula for the job if that may suit
=IF(ISERROR(VLOOKUP(ACurRow;A$1:A(CurRow-1);1;FALSE));SUMIF(A$1:A$LastRow;ACurRow;E$1:E$LastRow);"")
Enter the formula in your expected results column on any row - except the first one. This is the row I am referring to as "CurRow"
replace the "CurRow" and "LastRow" references to your actual values in the formula
paste the formula in all other rows

Answer 2

I solved the problem. I have changed the way but is what I want. The code below:
find duplicates name from column A
copy once each name in column F
calculate the sum of the numbers matched to each name.
I get the results in column G.
The code:
Sub sum()
Dim cell As Range
Dim ws As Worksheet
Dim rngA As Range
Dim myString As String
Dim i As Integer
Dim Found As Boolean
Set ws = Sheets("Sheet1")
ws.Select
lastrRowA = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("F2:G" & lastrRowA).Clear
Set rngA = ws.Range("A2:A" & lastrRowA)
'find duplicates in column A and copy once in column F
For Each cell In rngA
myString = cell.Value
i = 2
Found = False
While ws.Cells(i, 6).Value <> "" And Not Found
If ws.Cells(i, 6).Value = myString Then
Found = True
End If
i = i + 1
Wend
If Not Found Then
ws.Cells(i, 6).Value = myString
End If
Next
'ascending column F
ws.Select
ws.Range("F2:F" & lastrRowA).Select
Selection.sort Key1:=Range("F1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
ws.Range("A1").Select
'sum the numbers(from column E) for each Name (i.e. Michael=16+20=36 etc.) and put the results in col G
For RRF = 1 To ws.Range("F" & Rows.Count).End(xlUp).Row
NT = ws.Range("F" & RRF).Value
For RR1 = 1 To lastrRowA
If NT = ws.Range("A" & RR1).Value Then ws.Range("G" & RRF).Value = ws.Range("G" & RRF).Value + ws.Range("E" & RR1).Value
Next RR1
Next RRF
End Sub