Consolidation: Combining groups of identical items

[Jason]

I have four ranges of cells on separate rows. I want to be able to
consolidate groups of identical items from these rows into a list in a
column. In addition I need to sum the numbers associated with the
item (numbers are directly below the item in case that helps)

A visual simplification:

Col A Col B Col C Col D
R 1 apple apple apple pear
R 2 5.5 5.5 5.5 3
R 3
R 4 pear dog dog rabbit
R 5 3 5 5 6
R 6
R 7 apple apple apple apple
R 8 5.5 5.5 5.5 5.5
R 9
R 10 cat apple cat cat
R 11 2 5.5 2 2
R 12

Would consolidate by way of a macro (or perhaps a trick array
formula?) into:

Col A Col B
R 50 Item Sum
R 51 apple 16.5
R 52 pear 3
R 53 pear 3
R 54 dog 10
R 55 rabbit 6
R 56 apple 22
R 57 cat 2
R 58 apple 5.5
R 59 cat 4

Where one row ends in a item that is the same as the first item on the
next row (eg pear on rows 1 and 4) the item appears twice and is not
treated as a 'group'.

I appreciate that providing a complete solution would be a huge ask,
but I thought I'd throw it out there to see what advice I could get.
I've searched these newsgroups and have found valuable chunks of code
and useful formulae, but I have been unable to combine this to work
for my scenario.

Any words of wisdom are appreciated.

 

[shockley]

Jason,

Here's an example of how to do it (at least, it worked for me using your
sample tables)--I put the source table on Sheet "1" and the results table on
Sheet "2", each table starting in cell "A1":


Private rngItem As Range
Sub Consolidate()
x = 1
y = 0
Do
With Sheets("1")
y = y + 1
sItem = .Cells(x, y)
If sItem <> Empty Then
nValue = .Cells(x + 1, y)
If sItem <> OldItem Then ItemRange
rngItem.Value = sItem
rngItem.Offset(0, 1).Value = rngItem.Offset(0, 1).Value +
nValue
OldItem = sItem
Else
x = x + 3
y = 0
OldItem = ""
If .Cells(x, 1) = Empty Then Exit Do
End If
End With
Loop
End Sub
Sub ItemRange()
With Sheets("2")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rngItem = .Cells(LastRow + 1, 1)
End With
End Sub

HTH,
Shockley

 

[shockley]

PS, You need to put the column labels "Item" and "Sum" in Cells "A1" and
"B1" on Sheet "2" before running the macro.

Shockley