Announcement

Collapse
No announcement yet.

Merge Duplicates then Sum and Count values

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Merge Duplicates then Sum and Count values



    I often need to merge multiple occurences of data (tax addresses & tax names) and to sum or count the values associated with each invividual instance (i.e number of units per tax address). Data can often be thousands of rows and varies every time. I would like to keep all of the associated information with each entry for mailing purposes. I saw this link...
    http://www.ozgrid.com/forum/showthread.php?t=83101

    However, the VBA macro, when run, only keeps my tax address an the associated sum. Please let me know if there is a way to alter the code to make this possible. I will attach the file I am working with.
    Attached Files
    Last edited by AAE; May 26th, 2010, 04:47. Reason: Amend thread title

  • #2
    Re: Merge Duplicates then Sum and Count values

    awilkins,

    Welcom to Ozgrid.

    Please take the time to read the rules regarding thread titles and, in future posts, do not use phrases/words like "Please Help". Your thread title should accurately reflect your question or need and not assume a solution.
    Thread titles are used to return relevant search results, so think "search friendly" when developing the title.

    Thanks,

    AAE
    AAE
    ----------------------------------------------------

    Forum Rules | Message to Cross Posters | How to use Tags

    Comment


    • #3


      Re: Merge Duplicates then Sum and Count values

      Next code could help for the active sheet
      Code:
      Option Explicit
      
      Sub Remove_Duplicate()
      Dim LastRow As Long
          Application.ScreenUpdating = False      '   NO  SCREEN  UPDATING  TO SPEED UP
          LastRow = Range("A" & Rows.Count).End(xlUp).Row '  LAST  ROW CALCULATION
          If (ActiveSheet.AutoFilterMode) Then ActiveSheet.AutoFilterMode = False '  REMOVE  AUTOFILTER  IF  EXIST
          Columns("G:H").Insert Shift:=xlToRight      '  ADD  2  COLUMNS TO GIVE PLACE FOR FORMULAS
          Range("G2").Formula = "=SUMPRODUCT((A$2:A$" & LastRow & "=A2)*(B$2:B$" & LastRow & "=B2)*(F$2:F$" & LastRow & "))"
          Range("H2").Formula = "=IF(SUMPRODUCT((A$2:A2=A2)*(B$2:B2=B2))=1,"""",1)"
          Range("G2:H" & LastRow).FillDown    '  COPY FORMULAS IN THE COMPLETE COLUMNS
      '------     KEEP VALUES  REMOVE  FORMULAS
          Columns("G:H").Copy
          Columns("G:H").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
          
          Range("G2:G" & LastRow).Copy Destination:=Range("F2")       '  UPDATE NUMBER UNIT COLUMN
          Columns("H:H").SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete        '  REMOVE  EXTRA  ROWS
              
      '-------  INSTALL  AUTO FILTER   -------
          Columns("G:H").Delete Shift:=xlToLeft
          Range("A1").CurrentRegion.AutoFilter         '  INSTALL  AUTOFILTER
          Application.ScreenUpdating = True            '   GET BACK SCREEN  UPDATING
      End Sub
      Attached Files
      Last edited by PCI; May 26th, 2010, 22:33. Reason: Complement of information
      Triumph without peril brings no glory: Just try

      Comment

      Working...
      X