Conditional Copy and paste

[noobstarrr]

Hello, I have a sheet of data where column one is a list of names and column two is a list of dates. Some names have multiple dates (multiple entries). I need help writing a macro that copies and pastes the rows of data onto a new sheets and if a name is repeated the rows are pasted together on a single line. Here is an example of what I mean:

Name	Date	var1	var2	var3
Jim	1/2/18	a	b	c
Jim	6/2/18​ <strike></strike>	d	e	f
Jim	12/2/18​ <strike></strike>	g	h	i
Bob	5/2/18​ <strike></strike>	j	k	l
Kelly	2/2/18​ <strike></strike>	m	n	o
Kelly	3/2/18 ​ <strike></strike>	p	q	r

<tbody>
</tbody>

Would yield:

Name​ <strike></strike>

<strike></strike> Date.1​ <strike></strike>

<strike></strike> var1.1​ <strike></strike>

<strike></strike> var2.1​

<strike></strike> var3.1​ <strike></strike>

date.2

<strike></strike> var1.2​

<strike></strike> var2.2​ <strike></strike>

<strike></strike> var3.2​

date.3

<strike></strike> var1.3​

<strike></strike> var2.3​ <strike></strike>

<strike></strike> var3.3​ <strike></strike>

Jim

1/2/18​ <strike></strike>

a

b

c

6/2/18​ <strike></strike>

d

e

f

12/2/18​ <strike></strike>

g

h

i

Bob

5/2/18​ <strike></strike>

j

k

l

Kelley

3/2/18​ <strike></strike>

m

n

o

3/2/18​ <strike></strike>

p

q

r

<tbody>
</tbody>

None of the names have more than 3 entries. I have searched high and low and don't have enough experience myself to write the macro so any help is much appreciated!

 

[noobstarrr]

Also, I am happy to provide additional information if needed.

 

[Joe4]

Are they always sorted in name order, so all records that need to be combined for a person appear together, like shown in your example?
Or might the names be scattered throughout the list (so maybe Jim's records appear on rows 2, 5, and 10)?

 

[jmacleary]

Hi there. Try this code - it assumes no data beyond column E and that all your records for a given name are consecutive. If not, you could sort it first.

Sub Macro5()
'
' This code assumes data starts in A2 and there is no useful data to the right of column E
'

'
    lrow = Cells(Rows.Count, 1).End(xlUp).Row
    For thisrow = lrow To 2 Step -1
    If Range("a" & thisrow).Text = Range("a" & thisrow - 1).Text Then
    
       Range("f" + Format(thisrow - 1) + ":M" + Format(thisrow - 1)).Value = Range("B" + Format(thisrow) + ":I" + Format(thisrow)).Value
    
       Rows(thisrow).Delete Shift:=xlUp
    End If
    Next thisrow
End Sub

 

[noobstarrr]

@jmacleary this worked perfectly, thank you immensely!!

@Joe4 the answer to your question was yes, thank you for being willing to help me!


​