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

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"

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,015
Office Version
  1. 2019
Platform
  1. Windows
You don't need vba for that, a simple pivot table will do it.
Book2
ABCDEFGHI
1NameValue 1Value 2Value 3Name Value 1 Value 2 Value 3
2A527A142320
3C659B14812
4B836C161516
5A484
6C142
7A291
8C965
9B656
10A348
Sheet2
 

MazExpress

Board Regular
Joined
Aug 5, 2020
Messages
53
Office Version
  1. 2010
Platform
  1. Windows
You don't need vba for that, a simple pivot table will do it.
Book2
ABCDEFGHI
1NameValue 1Value 2Value 3Name Value 1 Value 2 Value 3
2A527A142320
3C659B14812
4B836C161516
5A484
6C142
7A291
8C965
9B656
10A348
Sheet2
You're totally right. But I want to build the vba to automate the task, so that anyone else (who cannot deal with Excel at all) can do it by just a mouse click.
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,015
Office Version
  1. 2019
Platform
  1. Windows
If the pivot is already in place and the data formatted as a table then you just need to refresh the pivot (which can be done by vba).
Refresh on save is always a good option so that they don't have to remember to click (hopefully they remember to save though) :eek:
 

MazExpress

Board Regular
Joined
Aug 5, 2020
Messages
53
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Unfortunately, it's not the case :) . A new workbook is generated monthly. So we have to repeat the same steps every time.
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,015
Office Version
  1. 2019
Platform
  1. Windows
Is the number of columns variable for each new workbook?

Does the original data need to be retained (summary table to the right as in your images) or can it be overwritten with the duplicate rows removed?
 

MazExpress

Board Regular
Joined
Aug 5, 2020
Messages
53
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

The number of columns is constant. The system generates the the same format every time. While the number of rows is variable from one month to another.

Yes, we need the original data to be retained.
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,015
Office Version
  1. 2019
Platform
  1. Windows
I've only done a very quick test with the retyped data that I used for the pivot earlier, see if this does what you need.
VBA Code:
Sub MazExpress08082020()
With Cells(1, Range("A1").CurrentRegion.Columns.Count + 2)
    .Consolidate Sources:="'[" & ActiveWorkbook.Name & "]" & ActiveSheet.Name & "'!" & Range("A1").CurrentRegion.Address(1, 1, xlR1C1), _
    Function:=xlSum, TopRow:=True, LeftColumn:=True, CreateLinks:=False
End With
End Sub
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,015
Office Version
  1. 2019
Platform
  1. Windows
You're welcome :)

I think it's one of my better efforts of late :oops: glad it worked well.

It will also work with a variable number of columns if needed, I didn't think of the method that I used until after I had asked if that was necessary.

One thing to note, if 2 (or more) columns have the same headers then they will also be consolidated in the same way as the rows. (as with the 2 columns labelled Value 1 below).
Book2
ABCDEFGH
1NameValue 1Value 2Value 1Value 1Value 2
2A527A3423
3C659C3215
4B836B268
5A484
6C142
7A291
8C965
9B656
10A348
Sheet2
 

Watch MrExcel Video

Forum statistics

Threads
1,114,277
Messages
5,546,935
Members
410,764
Latest member
Dedeke
Top