Merging rows

G

gdselva

Hi,

This is the input,

A B C D E
Selvam Private 100 20.10% India
Shankar Public 200 10.20% India
Gopi Private 200 20.30% India

I need the output like this in first row

A B
Selvam, Shankar, Gopi Private, Public, Private

C D E
500 50.50% India

I need to delete the 2nd and 3rd row.

Conditions:
1. In column A, the text is different, we have to merge those text an
retain the value in first row.
2. In column B, same condition of Column A
3. We have to add the values and put the new value in first row
4. same condition of 3
5. if the texts are same in E, we have to retain the single India no
India, India, India.

6. Finally we have to delete the 2 and 3 row


Please help me, It's very urgent,

Thank
 
G

Greg Wilson

My interpretation follows. The code as currently written
will consolidate the data starting from the active cell
row on down. Select a cell in the row that you want to
start from and run the macro. Suffice to say, ensure that
you have a copy of your data before running the macro. You
may have to correct the code for wordwrap.

Sub ConsolidateData()
Dim Rng As Range, DelRng As Range
Dim i As Long, ii As Long, Rw As Long
Rw = ActiveCell.Row
Set Rng = Range(Range("E" & Rw), Range("E" & Rw).End
(xlDown))
For i = 1 To Rng.Count - 1
For ii = i + 1 To Rng.Count
If Rng(ii) = Rng(i) Then
If DelRng Is Nothing Then _
Set DelRng = Rng(ii).EntireRow Else _
Set DelRng = Union(DelRng, Rng(ii).EntireRow)
Rng(i, -3) = Trim(Rng(i, -3) & "," & Rng(ii, -3))
Rng(i, -2) = Trim(Rng(i, -2) & "," & Rng(ii, -2))
Rng(i, -1) = Rng(i, -1) + Rng(ii, -1)
Rng(i, 0) = Rng(i, 0) + Rng(ii, 0)
End If
Next ii
Next i
DelRng.Delete
End Sub

Regards,
Greg
 
G

Greg Wilson

A more efficient version:

Sub ConsolidateData2()
Dim Rng As Range, DelRng As Range
Dim i As Long, ii As Long, Rw As Long
Rw = ActiveCell.Row
Set Rng = Range(Range("E" & Rw), Range("E" & Rw).End
(xlDown))
Application.ScreenUpdating = False
For i = Rng.Count To 2 Step -1
For ii = i - 1 To 1 Step -1
If Trim(Rng(ii)) = Trim(Rng(i)) Then
Rng(i, -3) = Trim(Rng(ii, -3) & "," & Rng(i, -3))
Rng(i, -2) = Trim(Rng(ii, -2) & "," & Rng(i, -2))
Rng(i, -1) = Rng(ii, -1) + Rng(i, -1)
Rng(i, 0) = Rng(ii, 0) + Rng(i, 0)
Rng(ii).EntireRow.Delete
End If
Next ii
Next i
Application.ScreenUpdating = True
End Sub

Regards,
Greg
 
Top