How to sum and merge similar cells in excel using vba? RRS feed

  • Question

  • Hi all,

    Please help me with this issue.

    I have got two columns in the below order

    a    2

    b    5

    c    1

    a    3

    a    4

    b    2

    d    1

    e    5

    c    6

    The output sheet should be of

    a   9

    b   7

    c   7

    d  1

    e  5

    please help.

    Thanks in Advance 

    Thursday, August 30, 2012 10:45 AM

All replies

  • On Thu, 30 Aug 2012 10:45:36 +0000, elninoshed wrote:
    >Hi all,
    >Please help me with this issue.
    >I have got two columns in the below order
    >a    2
    >b    5
    >c    1
    >a    3
    >a    4
    >b    2
    >d    1
    >e    5
    >c    6
    >The output sheet should be of
    >a   9
    >b   7
    >c   7
    >d  1
    >e  5
    >please help.
    >Thanks in Advance 
    No need for VBA.  You can use the SUMIF worksheet function.  If you MUST use VBA (e.g. school assignment), SUMIF is a useable property of the WorksheetFunction object.

    Thursday, August 30, 2012 12:06 PM
  • You could use a pivot table. If you don't have descriptive headers on your columns, insert a new row and name the first, for example, "Code" and the second "Value" 

    Then select a single cell in your table, and insert a pivot table, using Code in the row area and Value in the values area, set to sum. The specifics of how depend on your version - start with Help.

    Thursday, August 30, 2012 12:06 PM
  • That can be better done by PivotTable.Just you need to add a header before the data.

    Sum of ff2  
    ff Total
    a    9
    b    7
    c    0
    d    1
    e    5
    Grand Total 22

    Best Regards,
    Asadulla Javed, Kolkata
    Please do not forget to click “Vote as Helpful” if any post helps you and "Mark as Answer”if it solves the issue.

    Thursday, August 30, 2012 12:08 PM
  • actually this is not my exact requirement. It comes as a part in code. so i need vba itself to do the action.

    Column 1 will be containing a string value and from column 2 to 13 it will be having the integer values. something like

    a  2  4  6  8

    b  1  3  5  7

    c   1  2  3  4

    d   2  4  5  7

    a   1  3  5  7

    c    2  3  2  1

    the output should be sumthing like

    a  3  7  11  15

    b  1  3   5    7

    c   3  5  5    5

    d  2   4   5  7

    please help me with this. i need the vba code for this.

    Thursday, August 30, 2012 12:55 PM
  • Again, you do not need VBA. Use a pivot table, with five headers for your data table, using the last four as data fields. Then move the labels to the columns - And the specifics still depend on your version of Excel.
    Thursday, August 30, 2012 1:24 PM
  • boss, the problem is wat i told you earlier. this is not my exaact requrement.. this comes as a small part in my code... i need vba code for that..even i know how to accomplish it with pivot table...the top example which i told is jus the way of how the input and output is...please help me with the vba code
    Friday, August 31, 2012 8:30 AM
  • A pivot table is still the best way.  Is there some reason, since you need VBA code, that you cannot just implement the Pivot Table in code, and then use the results?

    Still, without your "exact requirements", you will need to adjust the code to fit.  But here is an example of how to accomplish what you want using a Pivot Table in code.  You may want to enable screenupdating and put in some break points, so as to be able to understand it well enough to adapt it to your specific requirements.

    I assume you know how to enter VBA code, since you indicate you are working on a project which requires it.  The following will place the results into the area below your source data.  It does assume your data is laid out as you have presented it here, and that the source data table is separated from anything else on the page by a blank column and row.

    It further assumes that there is nothing of value below your data table, since that is where the results are going.

    You can easily change these options in code.

    The Pivot sheet is created for this purpose, and then deleted after the results are obtained.

    Option Explicit
    Sub SumSimilar()
        Dim rSrc As Range, rPivotSrc As Range, rPivot As Range
        Dim rDest As Range 'for results
        Dim wsSrc As Worksheet, pivotSheet As Worksheet
        Dim i As Long
        Dim p As PivotField
    Set wsSrc = ActiveSheet
    Set rSrc = wsSrc.Range("A1").CurrentRegion
    Set rDest = rSrc.Offset(rowoffset:=rSrc.Rows.Count + 5)
    Application.ScreenUpdating = False
    Set pivotSheet = Worksheets.Add
    rSrc.Copy Destination:=Range("A2")
    Range("A1").Value = "Label"
    For i = 2 To rSrc.Columns.Count
        Cells(1, i).Value = "Value" & i - 1
    Next i
    Set rPivotSrc = Range("A1").CurrentRegion
    Set rPivot = rPivotSrc(rPivotSrc.Rows.Count + 5, 1)
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
        SourceData:=rPivotSrc, Version:=xlPivotTableVersion12).CreatePivotTable _
            TableDestination:=rPivot, _
    With pivotSheet.PivotTables(1).PivotFields("Label")
            .Orientation = xlRowField
            .Position = 1
    End With
    With pivotSheet.PivotTables(1)
        For Each p In .PivotFields
            If Not p.Name = "Label" Then
                .AddDataField p, "Sum " & p.Name, xlSum
            End If
        Next p
        .PivotSelect "Label[All]", xlDataAndLabel, True
        Selection.Copy Destination:=rDest(1, 1)
        Application.CutCopyMode = False
    End With
    Application.DisplayAlerts = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    End Sub


    Friday, August 31, 2012 11:38 AM
  • I have assumed your table is on Sheet1 in columns A to E, with nothing else in those columns:

    Sub TestMacro()
        Dim myC As Range
        Dim myS As Range

        With Worksheets("Sheet1")
            For Each myC In .Range(.Range("A2"), .Cells(Rows.Count, 1).End(xlUp))
                If Application.CountIf(.Range("A2", myC), myC.Value) = 1 Then
                    For Each myS In myC.Offset(0, 1).Resize(1, 4)
                        myS.Value = Application.SumIf(.Range("A:A"), myC.Value, myS.EntireColumn)
                    Next myS
                    myC.Resize(1, 5).Clear
                End If
            Next myC

            .Range("A:E").SpecialCells(xlCellTypeBlanks).Delete xlUp
        End With
    End Sub

    Friday, August 31, 2012 1:15 PM
  • And here is another approach that does not use a Pivot Table.  It assumes your data is isolated in the upper left corner of the active sheet (as before) and puts the results below the table.

    It also assumes that the first column consists of text labels, and the remaining columns contain numeric data.  However, the number of columns can vary.  It also assumes that there is no row of labels, as shown in your examples.

    You should experiment with the Pivot table (via VBA), this approach and Bernie's method to see which suits your data best:

    Option Explicit
    Sub SumSimilar2()
        Dim rSrc As Range, c As Range
        Dim rDest As Range
        Dim vRes() As Variant
        Dim colLabels As Collection
        Dim i As Long, j As Long
    Set rSrc = Range("A1").CurrentRegion
    Set rDest = Cells(rSrc.Rows.Count + 5, 1)
        rDest.Resize(rowsize:=rSrc.Rows.Count + 10, columnsize:=rSrc.Columns.Count).ClearContents
    Set colLabels = New Collection
    'generate list of unique labels
    On Error Resume Next
        For Each c In rSrc.Columns(1).Cells
            colLabels.Add Item:=c.Text, Key:=c.Text
        Next c
    On Error GoTo 0
    ReDim vRes(1 To colLabels.Count, 1 To rSrc.Columns.Count)
        For i = 1 To UBound(vRes, 1)
            vRes(i, 1) = colLabels(i)
                For j = 2 To UBound(vRes, 2)
                    vRes(i, j) = WorksheetFunction.SumIf(rSrc.Columns(1), vRes(i, 1), rSrc.Columns(j))
                Next j
        Next i
    Set rDest = rDest.Resize(rowsize:=UBound(vRes, 1), columnsize:=UBound(vRes, 2))
    rDest = vRes
    End Sub


    Friday, August 31, 2012 6:13 PM
  • elninoshed are you satisfied with answer?

    Mark one.

    Oskar Shon, Office System MVP

    Press if Helpful; Answer when a problem solved

    Tuesday, September 4, 2012 6:42 PM