Extend functionality of my code

MazExpress

Board Regular
Joined
Aug 5, 2020
Messages
53
Office Version
  1. 2010
Platform
  1. 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 ?


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.
 

Attachments

  • Inked8-81_LI.jpg
    Inked8-81_LI.jpg
    130.2 KB · Views: 10
  • Inked8-81_L2.jpg
    Inked8-81_L2.jpg
    160.8 KB · Views: 10

MazExpress

Board Regular
Joined
Aug 5, 2020
Messages
53
Office Version
  1. 2010
Platform
  1. Windows
It has exceeded my needs by far. So simple and customizable code.
Really appreciated.👏🎩
 

Some videos you may like

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

Watch MrExcel Video

Forum statistics

Threads
1,114,070
Messages
5,545,813
Members
410,708
Latest member
SanTrapGamer
Top