PDA

View Full Version : [SOLVED:] Combine data in two column if sum of column is same



shan
07-26-2015, 10:38 PM
Hello ,

Good Morning..

Request your assistance on below.

I have data in multiple column. Would like to combine the column if sum of column is same.

If sum of B column is matching with any column then want to club the data and remaining keep as it is....

Note: No restriction on column and rows.

Raw data:

A B C D E F G H I J K L



BJA
HKK
ISR
JKK
KHA
KUA
MNK
SEA
SHR
SIE
TYW


FB
ANN
ANN
ANN
ANN
ANN
ANN
ANN
ANN
ANN
ANN
ANN


BCR2J
10%
10%
10%
9%
10%
10%
6%
7%
10%
0%
10%


BCR3J
10%
10%
10%
9%
10%
10%
6%
7%
10%
0%
10%


CCR2J
12%
12%
12%
10%
12%
10%
8%
9%
12%
10%
12%


CCR3J
12%
12%
12%
10%
12%
10%
8%
9%
12%
10%
12%


DCR2J
10%
10%
10%
9%
10%
12%
9%
7%
10%
12%
14%


DCR3J
10%
10%
10%
9%
10%
12%
9%
7%
10%
12%
14%


HCR2J
10%
10%
10%
9%
10%
10%
5%
7%
10%
10%
7%


HCR3J
10%
10%
10%
9%
10%
10%
5%
7%
10%
10%
7%


JCR2J
12%
12%
15%
10%
15%
10%
10%
9%
12%
10%
12%


JCR3J
12%
12%
15%
10%
15%
10%
10%
9%
12%
10%
12%


KCR2J
10%
10%
8%
9%
8%
12%
5%
5%
10%
12%
7%


KCR3J
10%
10%
8%
9%
8%
12%
5%
5%
10%
12%
7%


LCR2J






5%






LCR3J






5%






MCR2J
10%
10%
8%
9%
8%
12%
5%
5%
10%
12%
5%


MCR3J
10%
10%
8%
9%
8%
12%
5%
5%
10%
12%
5%


QCR2J
9%
9%
7%
7%
7%
10%
5%
5%
9%
12%
5%


QCR3J
9%
9%
7%
7%
7%
10%
5%
5%
9%
12%
5%


YCR2J
10%
10%
10%
9%
10%
10%
6%
7%
10%
10%
10%


YCR3J
10%
10%
10%
9%
10%
10%
6%
7%
10%
10%
10%




Output:
If you see in above data sum of column B,C and J is same, also sum of column D and F also same hence we need to combine data of B,C and J as in one column and D & F in one column. Rest column will remain as it is.
Combine column highlighted below






BJA HKK SHR
ISR KHA
JKK
KUA
MNK
SEA
SIE
TYW


FB
ANN
ANN
ANN
ANN
ANN
ANN
ANN
ANN


BCR2J
10%
10%
9%
10%
6%
7%
0%
10%


BCR3J
10%
10%
9%
10%
6%
7%
0%
10%


CCR2J
12%
12%
10%
10%
8%
9%
10%
12%


CCR3J
12%
12%
10%
10%
8%
9%
10%
12%


DCR2J
10%
10%
9%
12%
9%
7%
12%
14%


DCR3J
10%
10%
9%
12%
9%
7%
12%
14%


HCR2J
10%
10%
9%
10%
5%
7%
10%
7%


HCR3J
10%
10%
9%
10%
5%
7%
10%
7%


JCR2J
12%
15%
10%
10%
10%
9%
10%
12%


JCR3J
12%
15%
10%
10%
10%
9%
10%
12%


KCR2J
10%
8%
9%
12%
5%
5%
12%
7%


KCR3J
10%
8%
9%
12%
5%
5%
12%
7%


LCR2J




5%





LCR3J




5%





MCR2J
10%
8%
9%
12%
5%
5%
12%
5%


MCR3J
10%
8%
9%
12%
5%
5%
12%
5%


QCR2J
9%
7%
7%
10%
5%
5%
12%
5%


QCR3J
9%
7%
7%
10%
5%
5%
12%
5%


YCR2J
10%
10%
9%
10%
6%
7%
10%
10%


YCR3J
10%
10%
9%
10%
6%
7%
10%
10%


























Regards,
Shan

p45cal
07-27-2015, 01:16 AM
Adjust the red in the line below in the code (2nd line):

Set EntireTable = Range("A1:L22") 'adjust this line to suit, includes row and column headers.


Sub zxczxc2()
Dim RngToDelete As Range
Set EntireTable = Range("A1:L22") 'adjust this line to suit, includes row and column headers.
Set mydata = EntireTable.Resize(, EntireTable.Columns.Count - 1).Offset(, 1)
Set mydatabody = mydata.Resize(mydata.Rows.Count - 1).Offset(1)
With mydatabody
For colm1 = .Columns.Count To 2 Step -1
For colm2 = colm1 - 1 To 1 Step -1
ColumnsAreTheSame = True
For rw = 1 To .Rows.Count
If .Columns(colm1).Cells(rw) <> .Columns(colm2).Cells(rw) Then
ColumnsAreTheSame = False
Exit For
End If
Next rw
If ColumnsAreTheSame Then
With mydata
If RngToDelete Is Nothing Then Set RngToDelete = .Columns(colm1) Else Set RngToDelete = Union(RngToDelete, .Columns(colm1))
.Columns(colm2).Cells(1).Value = .Columns(colm2).Cells(1).Value & " " & .Columns(colm1).Cells(1).Value
.Columns(colm1).Value = "¬"
End With 'mydata
End If
Next colm2
Next colm1
End With 'mydatabody
RngToDelete.Delete xlShiftToLeft
End Sub

There are 2 sheets in the attached, identical, click the button on one of them to run the macro, keep the other 'as is' so you can copy it to experiment with.

shan
07-27-2015, 02:26 AM
Thanks Sir..

Is there any possibility to put the auto range in below code .. otherwise each time manually we need to update the range

EntireTable = Range("A1:L22")

p45cal
07-27-2015, 02:38 AM
It depends on what's around the table, if nothing then something along the lines of
Set EntireTable = Range("A1").currentregion
but if there are entirely blank rows or blank columns within the table or there are cells with data/formulae right next to the table then this will fail.
Is there something else that can be relied upon to determine the range of the table?
Perhaps attach a file with several typical sheets so I can explore.

Otherwise we could change the code so that the user selects the table on the sheet and then runs the macro.

shan
07-27-2015, 05:42 AM
thank you so much