Summarize Duplicates in Range and Keep All Column Headings

[2Ruff4U]

Hello, I have a range of data that has, among other things, sales in a transaction and an Account ID. I am trying to keep this list with the same column headings but if there are duplicates in the Account ID (because that account had more than one transaction) I want to keep the column headings, just keep the one Account ID with the sum total of all the instances of that Account ID and remove the duplicates. The result will be a list with the same column headings, unique Account IDs and the total for all transactions if there is more than one for that Account ID. I tried Subtotals but I lose the column heading and a Pivot Table doesn't seem to keep them either.
Thank you

 

[Legacy 143009]

Hi,

Do you have a particular reason for merging the fourth row to the first but not the first to the fourth? Does it matter?

 

[2Ruff4U]

Thanks for the reply. No, just as long as the Account ID is unique and any duplicates are summarized and dups removed. The Transaction ID is irrelevant as well.

 

[Legacy 143009]

How about like this? You will need Sheet2 to write values:

Sub test()
  Dim accountDic As Object, accounts As Variant, temp As Variant, i As Long, account As Variant
  Set accountDic = CreateObject("Scripting.Dictionary")
  With Worksheets("Sheet1")
  accounts = .Range("A1:H" & .Cells(Rows.Count, "H").End(xlUp).Row)
  End With
  
  For i = 2 To UBound(accounts, 1)
    If Not accountDic.Exists(accounts(i, 8)) Then
      accountDic.Add accounts(i, 8), accounts(i, 1) & "|" & accounts(i, 2) & "|" & accounts(i, 3) & "|" & accounts(i, 4) & "|" & accounts(i, 5) & "|" & accounts(i, 6) & "|" & accounts(i, 7)
    Else
      temp = Split(accountDic(accounts(i, 8)), "|")
      accountDic(accounts(i, 8)) = temp(0) & "|" & temp(1) & "|" & temp(2) & "|" & temp(3) & "|" & temp(4) & "|" & (CDbl(temp(5)) + CDbl(accounts(i, 6))) & "|" & (CDbl(temp(6)) + CDbl(accounts(i, 7)))
    End If
  Next
  
  ReDim temp(1 To 8, 1 To 2)
  For i = 1 To 8
    temp(i, 1) = accounts(1, i)
  Next
  
  For Each account In accountDic
    For i = 1 To 7
      temp(i, UBound(temp, 2)) = Split(accountDic(account), "|")(i - 1)
    Next
    temp(UBound(temp, 1), UBound(temp, 2)) = account
    ReDim Preserve temp(1 To UBound(temp, 1), 1 To UBound(temp, 2) + 1)
  Next
  ReDim Preserve temp(1 To UBound(temp, 1), 1 To UBound(temp, 2) - 1)
  
  With Worksheets("Sheet2")
  .Range("A1").Resize(UBound(temp, 2), UBound(temp, 1)).Value = Application.Transpose(temp)
  End With
End Sub

 

[2Ruff4U]

Perfect, thank you so much!

 

[Legacy 143009]

Thanks for the reply. You are welcome

 

[2Ruff4U]

Hello, again thanks for your help. I have run into a problem however. My list of transactions is long, currently at abut 67,000 and the VBA is giving an overflow error (see image and VBA line) when the list hits about 40,000 or so. Thoughts?

 

[Legacy 143009]

Strange
I reckon it has something to do with data types rather than number of rows..
Do you have any numbers more than 12 digits? I don't know really.
One best way to test this is changing the line below. Does it make any difference?

accounts = .Range("A1:H100")

 

[alansidman]

With Power Query you can summarize you data as you wish very quickly. If you repost your data using XL2BB, then I will provide you with a solution. Cannot manipulate data in a picture. Since you are running 365, PQ is an integral part of your version and does not require any addins.

 

[2Ruff4U]

Strange
I reckon it has something to do with data types rather than number of rows..
Do you have any numbers more than 12 digits? I don't know really.
One best way to test this is changing the line below. Does it make any difference?

accounts = .Range("A1:H100")

Appreciated the reply, I did find the cause when I researched the error 6 and saw, as you asked, that it could be in the number length. I found a few data types formatted as "custom", with the ### in the field. Corrected that and all was well!