Reposting - Help for Merging rows

S

sp123

Hi All,

i have worksheet with the following format

1111 abc
1111 xyz
1111 x12
1234 qwe

I need help to merge column b values depending on column A.If two rows
have the same value in column a then i would like to append the value
of the cells in column b to the first row as shown below.
So i need the above data to appear as

1111 abc xyz x12
1234 qwe

Example shown in the attachment


thanks
sp123


+-------------------------------------------------------------------+
|Filename: example.zip |
|Download: http://www.excelforum.com/attachment.php?postid=4666 |
+-------------------------------------------------------------------+
 
G

Guest

Sub MergeData()
Dim lastrow as Long, i as Long
lastrow = cells(rows.count,1).End(xlup).Row
for i = lastrow to 2 step -1
if cells(i,1).Value = cells(i-1,1).Value then
cells(i-1,2).Value = cells(i-1,2).Value & " " & cells(i,2).Value
rows(i).Delete
End if
Next i
End Sub

Test it on a copy of your data.
 
D

Dave Peterson

You've got multiple threads in different newsgroups. You may want to choose the
appropriate location (.programming if you want code, .worksheet.functions if you
want formulas) and stick with one post.

Option Explicit
Sub testme()
Dim iRow As Long
Dim LastRow As Long
Dim FirstRow As Long
Dim wks As Worksheet

Set wks = Worksheets("Sheet1")

With wks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow + 1 Step -1
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value Then
.Range(.Cells(iRow, "B"), _
.Cells(iRow, .Columns.Count).End(xlToLeft)).Copy _
Destination:=.Cells(iRow - 1, .Columns.Count) _
.End(xlToLeft).Offset(0, 1)
.Rows(iRow).Delete
End If
Next iRow
End With
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top