MazExpress
Board Regular
- Joined
- Aug 5, 2020
- Messages
- 56
- Office Version
- 2010
- Platform
- Windows
Now, I have this code which produces the results showed in Picture 1. How to extend the functionality of this code to produce the results showed in Picture 2 ?
Thanks in advance.
VBA Code:
Sub SUM()
Dim i, j, k As Integer
i = 2
j = 2
Range("D1").Value = "NAME"
Range("E1").Value = "VALUE"
'copy the first value of column A to column D
Range("D2").Value = Range("A2").Value
'cycle to read all values of column B and sum it to column E; will run until find a blank cell
While Range("A" & i).Value <> ""
'this check if actual value of column A is equal to before value of column A, if true just add the column B value to E
'else, look for the row in column D where is the same value of column A, if it doesn't exist code create the value
'in column D and E
If Range("A" & i).Value = Range("A" & i - 1).Value Then
Range("E" & j).Value = Range("E" & j).Value + Range("B" & i).Value
Else
flag = 1
While Range("D" & flag).Value <> ""
If Range("A" & i).Value = Range("D" & flag).Value Then
j = flag
Range("E" & j).Value = Range("E" & j).Value + Range("B" & i).Value
flag = Range("D1").End(xlDown).Row
Else
j = 0
End If
flag = flag + 1
Wend
If j = 0 Then
Range("D1").End(xlDown).Offset(1, 0).Value = Range("A" & i).Value
Range("E1").End(xlDown).Offset(1, 0).Value = Range("B" & i).Value
j = Range("E1").End(xlDown).Row
End If
End If
i = i + 1
Wend
MsgBox "End"
End Sub
Thanks in advance.