Consolidate data with same text values

[vixell23]

Hi I need a code that would consolidate data that have the same non-amount values. To illustrate:

A B C
X Y 10
X Y 15
G H 12
G H 5
D S 3

Would then be consolidated as:

A B C
X Y 25
G H 17
D S 3

The original file would have hundreds of columna and thousands of rows.

Thanks in advance!

 

[oldbrewer]

concat

num

x

y

10

xy

10

x

y

15

xy

15

g

h

12

gh

12

g

h

5

gh

5

d

s

3

ds

3

Sum of num

concat

Total

xy

25

gh

17

ds

3

a helper table out of the way and a pivot table

Grand Total

45

if needed you can reformat the pivot to show x and y in separate columns

<colgroup><col span="9"><col><col><col span="2"></colgroup><tbody>
</tbody>

 

[Peter_SSs]

Try this code in a copy of your workbook. I'm assuming that the data has headings as in my example. If that is not the case, post back for modifications.

Sub Consol()
  Dim cols As Long, i As Long
  Dim d As Object
  Dim data As Variant, vals As Variant
  Dim combo As String
  
  Application.ScreenUpdating = False
  Set d = CreateObject("scripting.dictionary")
  d.CompareMode = vbTextCompare
  With Range("A1").CurrentRegion
    cols = .Columns.Count
    .Resize(, cols - 1).AdvancedFilter _
        Action:=xlFilterCopy, CopyToRange:=.Cells(1, cols + 2), Unique:=True
    data = .Resize(, cols - 1).Value
    vals = .Columns(cols).Value
    For i = 1 To UBound(data, 1)
      combo = Join(Application.Index(data, i, 0), "|")
      If d.exists(combo) Then
        d.Item(combo) = d.Item(combo) + vals(i, 1)
      Else
        d.Add combo, vals(i, 1)
      End If
    Next i
    .Cells(1, cols * 2 + 1).Resize(d.Count, 1).Value = Application.Transpose(d.items)
  End With
  Application.ScreenUpdating = True
End Sub

Given the original data in A1:D7 below, the code produced what you see in columns F:I

Excel Workbook
	A	B	C	D	E	F	G	H	I
1	Data 1	Data 2	Data 3	Value		Data 1	Data 2	Data 3	Value
2	X	Y	Z	10		X	Y	Z	25
3	X	Y	Z	15		G	H	A	12
4	G	H	A	12		G	H	Q	5
5	G	H	Q	5		D	S	S	8
6	D	S	S	3
7	D	S	S	5
8
Consolidate

 

[oldbrewer]

peter - he wants gh to be consolidated as well - I think.........ah no 3rd column differs - I did not read the exam question.........

 

[vixell23]

Try this code in a copy of your workbook. I'm assuming that the data has headings as in my example. If that is not the case, post back for modifications.

Sub Consol()
  Dim cols As Long, i As Long
  Dim d As Object
  Dim data As Variant, vals As Variant
  Dim combo As String
  
  Application.ScreenUpdating = False
  Set d = CreateObject("scripting.dictionary")
  d.CompareMode = vbTextCompare
  With Range("A1").CurrentRegion
    cols = .Columns.Count
    .Resize(, cols - 1).AdvancedFilter _
        Action:=xlFilterCopy, CopyToRange:=.Cells(1, cols + 2), Unique:=True
    data = .Resize(, cols - 1).Value
    vals = .Columns(cols).Value
    For i = 1 To UBound(data, 1)
      combo = Join(Application.Index(data, i, 0), "|")
      If d.exists(combo) Then
        d.Item(combo) = d.Item(combo) + vals(i, 1)
      Else
        d.Add combo, vals(i, 1)
      End If
    Next i
    .Cells(1, cols * 2 + 1).Resize(d.Count, 1).Value = Application.Transpose(d.items)
  End With
  Application.ScreenUpdating = True
End Sub

Given the original data in A1:D7 below, the code produced what you see in columns F:I

Excel Workbook
	A	B	C	D	E	F	G	H	I
1	Data 1	Data 2	Data 3	Value		Data 1	Data 2	Data 3	Value
2	X	Y	Z	10		X	Y	Z	25
3	X	Y	Z	15		G	H	A	12
4	G	H	A	12		G	H	Q	5
5	G	H	Q	5		D	S	S	8
6	D	S	S	3
7	D	S	S	5
8
Consolidate

Hi Peter! Thank you very much for this. Would it be possible for the resulting new matrix to be shown in another worksheet?

 

[Peter_SSs]

Hi Peter! Thank you very much for this. Would it be possible for the resulting new matrix to be shown in another worksheet?

Yes

Does that other worksheet already exist in the workbook?

If so,
- what is its name?
- is there anything already on it that needs to be kept? If so, what/where?

 

[vixell23]

Yes

Does that other worksheet already exist in the workbook?

If so,
- what is its name?
- is there anything already on it that needs to be kept? If so, what/where?

No there's no soecific worksheet. What I would like is for it to create a new worksheet in the same workbook containing the consolidated data. Again, thank you very much!

 

[vixell23]

Bump

 

[Peter_SSs]

No there's no soecific worksheet. What I would like is for it to create a new worksheet in the same workbook containing the consolidated data. Again, thank you very much!

Assuming the original data sheet is the active sheet when the code is run, try this.

Sub Consol_2()
  Dim cols As Long, i As Long
  Dim d As Object
  Dim data As Variant, vals As Variant
  Dim combo As String
  Dim wsOld As Worksheet, wsNew As Worksheet
  
  Application.ScreenUpdating = False
  Set wsOld = ActiveSheet
  Set wsNew = Sheets.Add(After:=wsOld)
  Set d = CreateObject("scripting.dictionary")
  d.CompareMode = vbTextCompare
  With wsOld.Range("A1").CurrentRegion
    cols = .Columns.Count
    .Resize(, cols - 1).AdvancedFilter _
        Action:=xlFilterCopy, CopyToRange:=wsNew.Range("A1"), Unique:=True
    data = .Resize(, cols - 1).Value
    vals = .Columns(cols).Value
    For i = 1 To UBound(data, 1)
      combo = Join(Application.Index(data, i, 0), "|")
      If d.exists(combo) Then
        d.Item(combo) = d.Item(combo) + vals(i, 1)
      Else
        d.Add combo, vals(i, 1)
      End If
    Next i
    wsNew.Cells(1, cols).Resize(d.Count, 1).Value = Application.Transpose(d.items)
  End With
  Application.ScreenUpdating = True
End Sub