VBA consolidation of data

[tonkerthomas]

Good afternoon everybody

I have a very large table (14000 rows) of contract data, an extract of which I've simplified here. Each row in that table has a contract identifier ("ID") which may or may not be unique, depending on the complexity of the contract. Within each row, there may or may not be an "option" to break and/or an option to renew that contract. Where options do exist, they have identifying numbers. Although there can be break AND renew options in the same row, there will only ever be one of each. Options are not necessarily contract exclusive - they can apply to many IDs, or just one.

My problem is that where there is more than one option to break and/or more than one option to renew, they have been included in my data by adding a row, identical to the row above it in every aspect except the option ID, thus:


[TABLE="class: grid, width: 600, align: center"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Break 1[/TD]
[TD]Break 2[/TD]
[TD]Break 3[/TD]
[TD]Break 4[/TD]
[TD]Renew 1[/TD]
[TD]Renew 2[/TD]
[TD]Renew 3[/TD]
[TD]Renew 4[/TD]
[/TR]
[TR]
[TD]867[/TD]
[TD]4102[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]4202[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]867[/TD]
[TD]4105[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]4206[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]867[/TD]
[TD]4104[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]4211[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]867[/TD]
[TD]4117[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]4203[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


I need to consolidate this data. Where the IDs are the same but there are differing values in the Break 1 and/or Renew 1 columns, then whatever is in the second (third, fourth) row of the data needs to move into a new column in one row, thus:

[TABLE="class: grid, width: 600, align: center"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Break 1[/TD]
[TD]Break 2[/TD]
[TD]Break 3[/TD]
[TD]Break 4[/TD]
[TD]Renew 1[/TD]
[TD]Renew 2[/TD]
[TD]Renew 3[/TD]
[TD]Renew 4[/TD]
[/TR]
[TR]
[TD]867[/TD]
[TD]4102[/TD]
[TD]4105[/TD]
[TD]4104[/TD]
[TD]4117[/TD]
[TD]4202[/TD]
[TD]4206[/TD]
[TD]4211
[/TD]
[TD]4203[/TD]
[/TR]
</tbody>[/TABLE]

There can be anywhere between one and four rows per contract, but there will never be more than four. As in my "before" example, the extra columns for the additional options are already in the table and are currently empty. Once the options have been moved, the rows which previously held them need to be deleted.

Again, this process only applies to rows which share an ID. Where the IDs are not the same, I don't need to do anything.

Does that make sense? Can anybody help me? I assume this will be a VBA job, but if there's some way of doing it with formula logic, I'm all ears.

Many, many thanks in advance to you all.

Jeff

 

[MickG]

Try this for data (header) starting "A1" .

[COLOR="Navy"]Sub[/COLOR] MG20Dec31
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Array(Dn, 1)
    [COLOR="Navy"]Else[/COLOR]
        Q = .Item(Dn.Value)
            Q(1) = Q(1) + 1
            Q(0).Offset(, Q(1)).Value = Dn.Offset(, 1)
            Q(0).Offset(, Q(1) + 4).Value = Dn.Offset(, 5)
           .Item(Dn.Value) = Q
            Dn.Offset(, 1).ClearContents
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
Rng.Offset(, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Fluff]

Or with formulae

Excel 2013/2016
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
1	ID	Break 1	Break 2	Break 3	Break 4	Renew 1	Renew 2	Renew 3	Renew 4		ID	Break 1	Break 2	Break 3	Break 4	Renew 1	Renew 2	Renew 3	Renew 4
2	867	4102				4202					867	4102	4105			4202	4211	4203
3	867	4105									868	4102	4105	4104	4117	4202	4206	4203
4	867					4211
5	867					4203
6	868	4102				4202
7	868	4105				4206
8	868	4104
9	868	4117				4203
Project

Cell Formulas
Range	Formula
K2	{=INDEX($A$2:$A$9,MATCH(0,COUNTIF($K$1:$K1,$A$2:$A$9),0))}
L2	{=IFERROR(INDEX($B$2:$B$9,SMALL(IF(($A$2:$A$9=$K2)*($B$2:$B$9<>""),ROW($A$2:$A$9)-ROW($A$2)+1),COLUMNS($A:A))),"")}
M2	{=IFERROR(INDEX($B$2:$B$9,SMALL(IF(($A$2:$A$9=$K2)*($B$2:$B$9<>""),ROW($A$2:$A$9)-ROW($A$2)+1),COLUMNS($A:B))),"")}
N2	{=IFERROR(INDEX($B$2:$B$9,SMALL(IF(($A$2:$A$9=$K2)*($B$2:$B$9<>""),ROW($A$2:$A$9)-ROW($A$2)+1),COLUMNS($A:C))),"")}
O2	{=IFERROR(INDEX($B$2:$B$9,SMALL(IF(($A$2:$A$9=$K2)*($B$2:$B$9<>""),ROW($A$2:$A$9)-ROW($A$2)+1),COLUMNS($A:D))),"")}
P2	{=IFERROR(INDEX($F$2:$F$9,SMALL(IF(($A$2:$A$9=$K2)*($F$2:$F$9<>""),ROW($A$2:$A$9)-ROW($A$2)+1),COLUMNS($A:A))),"")}
Q2	{=IFERROR(INDEX($F$2:$F$9,SMALL(IF(($A$2:$A$9=$K2)*($F$2:$F$9<>""),ROW($A$2:$A$9)-ROW($A$2)+1),COLUMNS($A:B))),"")}
R2	{=IFERROR(INDEX($F$2:$F$9,SMALL(IF(($A$2:$A$9=$K2)*($F$2:$F$9<>""),ROW($A$2:$A$9)-ROW($A$2)+1),COLUMNS($A:C))),"")}
S2	{=IFERROR(INDEX($F$2:$F$9,SMALL(IF(($A$2:$A$9=$K2)*($F$2:$F$9<>""),ROW($A$2:$A$9)-ROW($A$2)+1),COLUMNS($A:D))),"")}
Press CTRL+SHIFT+ENTER to enter array formulas.