MACRO: Consolidate 'like' entries in table as one entry

Ife anyone requires additional information or finds my post confusing please let me know and I'd be happy to clarify

Since you want to consolidate columns B and C only, the first match row would be appear in column E.
The output is in new sheet.

You should like at the output and see if the code works for you.

I see what you've done, however I need the macro to work within the single spreadsheet, not create a new one. I'm sorry but this doesn't work for me but its close!

Can anyone help me please?

The code works as long as you can cope with merged cells. Merged cells are nightmare in excel, so if you have merged cells, you will get a funny output.

Unless you get rid of the merged cells, the code will not work.

Which merged cells? None of the affected data contains merged cell. The title for the workbook is a merged cell, as well as the title of that particular table.

UPDATE ON EXAMPLE SPREADSHEET BEFORE & AFTER.

See attached.

This should do

Sub test()
    Dim a, i As Long, ii As Long, n As Long
    With Range("a5").CurrentRegion
        With .Offset(2, 1).Resize(.Rows.Count - 2, .Columns.Count - 1)
            a = .Value
            .ClearContents
            With CreateObject("Scripting.Dictionary")
                .CompareMode = 1
                For i = 1 To UBound(a, 1)
                    If a(i, 1) = "" Then Exit For
                    If Not .exists(a(i, 1)) Then
                        n = n + 1: .Item(a(i, 1)) = n
                        For ii = 1 To UBound(a, 2)
                            a(n, ii) = a(i, ii)
                        Next
                    Else
                        For ii = 2 To UBound(a, 2)
                            a(.Item(a(i, 1)), ii) = _
                            a(.Item(a(i, 1)), ii) + a(i, ii)
                        Next
                    End If
                Next
            End With
            .Resize(n).Value = a
        End With
    End With
End Sub

Hey Jindon thanks a lot! However this code alters column 'E', I need that column to remain unaltered by the code.

Ahhh, OK

Change

            End With
            .Resize(n).Value = a
        End With

to

            End With
            With .Resize(n)
                .Value = a
                .Columns(4).Formula = "=rc[-2]/rc[-1]"
            End With
        End With

THANK YOU THANK YOU THANK YOU !!! A week I've been contending with this code and you've done it in a half hour span! Thank you so much!

You mean?

Sub test()
    Dim a, i As Long, ii As Long, n As Long
    With Range("a5").CurrentRegion
        With .Offset(2, 1).Resize(.Rows.Count - 2, .Columns.Count - 1)
            a = .Value
            .ClearContents
            With CreateObject("Scripting.Dictionary")
                .CompareMode = 1
                For i = 1 To UBound(a, 1)
                    If a(i, 1) = "" Then Exit For
                    If Not .exists(a(i, 1)) Then
                        n = n + 1: .Item(a(i, 1)) = n
                        For ii = 1 To UBound(a, 2)
                            a(n, ii) = a(i, ii)
                        Next
                    Else
                        For ii = 2 To UBound(a, 2) - 1
                            a(.Item(a(i, 1)), ii) = _
                            a(.Item(a(i, 1)), ii) + a(i, ii)
                        Next
                    End If
                Next
            End With
            .Resize(n).Value = a
        End With
    End With
End Sub

No. I mean so that when the data is consolidated it will still calculate the average/transaction which is what column 'E' does. Your code writes over that column.

What is being consolidated is strictly column 'B' 'C' and 'D'. Not 'A or 'E'

No problem.

Please don't forget to mark this thread as "Solved".

Re your message.

You don't want to get col.E to be changed?

Sub test()
    Dim a, i As Long, ii As Long, n As Long
    With Range("a5").CurrentRegion
        With .Offset(2, 1).Resize(.Rows.Count - 2, .Columns.Count - 2)
            a = .Value
            .ClearContents
            With CreateObject("Scripting.Dictionary")
                .CompareMode = 1
                For i = 1 To UBound(a, 1)
                    If a(i, 1) = "" Then Exit For
                    If Not .exists(a(i, 1)) Then
                        n = n + 1: .Item(a(i, 1)) = n
                        For ii = 1 To UBound(a, 2)
                            a(n, ii) = a(i, ii)
                        Next
                    Else
                        For ii = 2 To UBound(a, 2)
                            a(.Item(a(i, 1)), ii) = _
                            a(.Item(a(i, 1)), ii) + a(i, ii)
                        Next
                    End If
                Next
            End With
            With .Resize(n)
                .Value = a
                .Columns(4).Formula = "=rc[-2]/rc[-1]"
            End With
        End With
    End With
End Sub

Jindon, just one more thing I promise I feel so bad for taking so much of your time.

When you clear the contents of columns 'B thru D' it leaves column 'E' with this:

#Div/0!

But it should still say '0' because this code: =IF(D10=0,"0",C10/D10) [ignore that specific range] should remain unchanged even after the contents of B thru D are cleared.

I bow to your skills!

OOps,

Can you replace back to the original?

            End With
            With .Resize(n)
                .Value = a
                .Columns(4).Formula = "=rc[-2]/rc[-1]"
            End With
        End With

to

            End With
            .Resize(n).Value = a
        End With

Thank you its complete. If your ever in Mississauga, Ontario, Canada send me a line. I owe you a drink!