How can I automate copying rows to another tab BUT always add the newest additions to the end?

[steve80s]

Hi All,
Sorry if that isn't very clear. What I have is a spreadsheet where I have a MAIN LOG, which I use to keep track of client appointment and report timescales. That all works fine, so don't worry too much about that. What I need help with is this. When 'Y' is entered in Column R (indicating a blood test has been requested), I need a way for Excel to automatically copy information from that row to my BLOODS tab. For example, if I enter Y in R7 of the MAIN LOG, I need parts of Row 7 to copy over parts of this row to Row 4 Columns B-H on the BLOODS tab. After that, additional info on the bloods progress can be manually entered in columns I onwards.

I have found an INDEX formula which populates this. However, let's say I've already had Rod Flanders (Row 7) copied over to Row 4 of BLOODS, but then someone adds a Y to MAIN LOG Row 5 (Lisa Simpson's row). What happens is the BLOODS tab adds Lisa's data to Row 4, and moves Rod Flanders down to Row 5. This is a problem, because if I have added manual data to Rod's row already in Columns I, J, K etc, this data will stay where it is, even though Rod's other details will be on a different row now, and it looks like that data related to Lisa Simpson.

I suppose what I need is for each time MAIN LOG Column R has a Y put in it, it sends a permanent copy to the next free row of the BLOODS tab, which doesn't get re-ordered when another MAIN LOG client has a test requested. ie. if Rod Flanders gets copied to BLOODS Row 4, it stays there, even if Bart Simpson and Lisa Simpson subsequently have bloods requested. They should be copied to Rows 5 and 6 as they had the Column R 'Y' added after Rod Flanders.

Hope that makes sense? Please see screenshots below of my 2 different tabs

 

[RudRud]

Book5
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
3	Current Days Waiting	Target Date	Current Status	Final Comp	clinic type	clinic date	Attended or DNA	clinician	Client no.	Client Name	Dob	date d	date r	date f	Formatted admin name	sign off date	date sent	bloods requested
4	57	6/2/2023	Complete	3	Neuro	6/2/2023	Attended	Homer	101	Robert	1/1/2010	1/1/2010	1/1/2010	1/1/2010	a	b	c	Y
5	58	6/3/2023	Complete	2	Dcd	6/3/2023	Attended	R	102	Nobert	2/1/2010	2/1/2010	2/1/2010	2/1/2010	d	f	e
6	59	6/4/2023	Complete	1	jac	6/4/2023	Attended	weer	103	Sobert	3/1/2010	3/1/2010	3/1/2010	3/1/2010	a	b	c
7	60	6/5/2023	Send	2	vd	6/5/2023	Attended	Teres	104	Labert	4/1/2010	4/1/2010	4/1/2010	4/1/2010	d	f	e	Y
8	60	6/6/2023	Pend	3	w	6/6/2023	Attended	Fellex	107	Pabert	5/1/2010	5/1/2010	5/1/2010	5/1/2010	d	f	e
9	1	6/7/2023	Complete	3	we	6/7/2023	Attended	Salles	105	Wabert	6/1/2010	6/1/2010	6/1/2010	6/1/2010	a	b	c
10	2	6/8/2023	Pend	4	r	6/8/2023	Attended	Males	106	Sur	7/1/2010	7/1/2010	7/1/2010	7/1/2010	d	f	e	Y
11	2	6/8/2023	Pend	4	r	6/8/2023	Attended	Males	106	Sur	7/1/2010	7/1/2010	7/1/2010	7/1/2010	d	f	e	Y
MainLog

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
F3:R3,E1:E11	Cell Value	duplicates	text	NO

Book5
	B	C	D	E	F	G	H	I	J
2	C Details
3	Clinic Date	Clinic type	Clinician	NHS No	Client Name	Date of Birth	admin	Bloods done	date of test
4	6/2/2023	Attended	Homer	101	Robert	1/1/2010
5	6/5/2023	Attended	Teres	104	Labert	4/1/2010
6	6/8/2023	Attended	Males	106	Sur	7/1/2010
7	6/8/2023	Attended	Males	106	Sur	7/1/2010
Bloods

If using VBA, Right Click MainLog -> View code -> paste below code and run the code (f5)

Sub test()

With Sheets("MainLog")
a = .Range("f3:r" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
End With

ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))

For I = 1 To UBound(a, 1)
    If UCase(a(I, 13)) = "Y" Then
        k = k + 1
        For j = 1 To 6
            b(k, j) = a(I, j)
        Next j
    End If

Next I

With Sheets("Bloods")
.Range("b4").Resize(UBound(b, 1), UBound(b, 2) - 4).Value = b
End With

End Sub

 

[steve80s]

Hi RudRud,

Thank you for responding. However, there are 3 problems with this...

1 - When I run the VBA, it deletes and repopulates the list in BLOODS. What I need is it to leave clients already on the BLOODS, and just search for additional ones to add to the end
2 - While deleting and repopulating BLOODS, it also deletes the manual data I'm adding in Columns I onwards.
3 - The BLOODS Clinic Type column is being populated with the MAIN LOG 'Attended or DNA' column data rather than the Clinic Type data.

Is it possible to fix this please?

 

[RudRud]

Kindly give a try

Book5
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
3	Current Days Waiting	Target Date	Current Status	Final Completion Time	clinic type	clinic date	Attended or DNA	clinician	Client no.	Client Name	D.o.b.	Date Dictated	Date Rosetted	Date Formatted	Formatted by(Admin Name)	Sign-Off Date	Date Sent	Bloods Requested
4	57	6/2/2023	Complete	3	Neuro	6/2/2023	Attended	Homer	101	Robert	1/1/2010	1/1/2010	1/1/2010	1/1/2010	a	b	c	Y
5	58	6/3/2023	Complete	2	Dcd	6/3/2023	Attended	R	102	Nobert	2/1/2010	2/1/2010	2/1/2010	2/1/2010	d	f	e
6	59	6/4/2023	Complete	1	jac	6/4/2023	Attended	weer	103	Sobert	3/1/2010	3/1/2010	3/1/2010	3/1/2010	a	b	c
7	60	6/5/2023	Send	2	vd	6/5/2023	Attended	Teres	104	Labert	4/1/2010	4/1/2010	4/1/2010	4/1/2010	d	f	e	Y
8	60	6/6/2023	Pend	3	w	6/6/2023	Attended	Fellex	107	Pabert	5/1/2010	5/1/2010	5/1/2010	5/1/2010	d	f	e
9	1	6/7/2023	Complete	3	we	6/7/2023	Attended	Salles	105	Wabert	6/1/2010	6/1/2010	6/1/2010	6/1/2010	a	b	c
10	2	6/8/2023	Pend	4	r	6/8/2023	Attended	Males	106	Sur	7/1/2010	7/1/2010	7/1/2010	7/1/2010	d	f	e	Y
11	2	6/8/2023	Pend	4	r	6/8/2023	Attended	Males	106	Sur	7/1/2010	7/1/2010	7/1/2010	7/1/2010	d	f	e	Y
MainLog

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
E3:R3	Cell Value	duplicates	text	NO

Book5
	B	C	D	E	F	G	H	I	J
2	C Details
3	Clinic Date	Clinic type	Clinician	NHS No	Client Name	Date of Birth	admin	Bloods done	date of test
4	6/2/2023	Neuro	Homer	101	Robert	1/1/2010
5	6/5/2023	vd	Teres	104	Labert	4/1/2010
6	6/8/2023	r	Males	106	Sur	7/1/2010
7	6/8/2023	r	Males	106	Sur	7/1/2010
Bloods

Sub test()
With Sheets("MainLog")
a = .Range("e3:r" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
End With

ReDim b(1 To UBound(a, 1), 1 To 6)

For i = 1 To UBound(a, 1)
    If UCase(a(i, 14)) = "Y" Then
        k = k + 1
            b(k, 1) = a(i, 2)
            b(k, 2) = a(i, 1)
            b(k, 3) = a(i, 4)
            b(k, 4) = a(i, 5)
            b(k, 5) = a(i, 6)
            b(k, 6) = a(i, 7)
    End If
Next i



Sheets("bloods").Range("b4").Resize(UBound(a, 1), 6).Value = b


End Sub

 

[steve80s]

Kindly give a try

Book5
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
3	Current Days Waiting	Target Date	Current Status	Final Completion Time	clinic type	clinic date	Attended or DNA	clinician	Client no.	Client Name	D.o.b.	Date Dictated	Date Rosetted	Date Formatted	Formatted by(Admin Name)	Sign-Off Date	Date Sent	Bloods Requested
4	57	6/2/2023	Complete	3	Neuro	6/2/2023	Attended	Homer	101	Robert	1/1/2010	1/1/2010	1/1/2010	1/1/2010	a	b	c	Y
5	58	6/3/2023	Complete	2	Dcd	6/3/2023	Attended	R	102	Nobert	2/1/2010	2/1/2010	2/1/2010	2/1/2010	d	f	e
6	59	6/4/2023	Complete	1	jac	6/4/2023	Attended	weer	103	Sobert	3/1/2010	3/1/2010	3/1/2010	3/1/2010	a	b	c
7	60	6/5/2023	Send	2	vd	6/5/2023	Attended	Teres	104	Labert	4/1/2010	4/1/2010	4/1/2010	4/1/2010	d	f	e	Y
8	60	6/6/2023	Pend	3	w	6/6/2023	Attended	Fellex	107	Pabert	5/1/2010	5/1/2010	5/1/2010	5/1/2010	d	f	e
9	1	6/7/2023	Complete	3	we	6/7/2023	Attended	Salles	105	Wabert	6/1/2010	6/1/2010	6/1/2010	6/1/2010	a	b	c
10	2	6/8/2023	Pend	4	r	6/8/2023	Attended	Males	106	Sur	7/1/2010	7/1/2010	7/1/2010	7/1/2010	d	f	e	Y
11	2	6/8/2023	Pend	4	r	6/8/2023	Attended	Males	106	Sur	7/1/2010	7/1/2010	7/1/2010	7/1/2010	d	f	e	Y
MainLog

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
E3:R3	Cell Value	duplicates	text	NO

Book5
	B	C	D	E	F	G	H	I	J
2	C Details
3	Clinic Date	Clinic type	Clinician	NHS No	Client Name	Date of Birth	admin	Bloods done	date of test
4	6/2/2023	Neuro	Homer	101	Robert	1/1/2010
5	6/5/2023	vd	Teres	104	Labert	4/1/2010
6	6/8/2023	r	Males	106	Sur	7/1/2010
7	6/8/2023	r	Males	106	Sur	7/1/2010
Bloods

Sub test()
With Sheets("MainLog")
a = .Range("e3:r" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
End With

ReDim b(1 To UBound(a, 1), 1 To 6)

For i = 1 To UBound(a, 1)
    If UCase(a(i, 14)) = "Y" Then
        k = k + 1
            b(k, 1) = a(i, 2)
            b(k, 2) = a(i, 1)
            b(k, 3) = a(i, 4)
            b(k, 4) = a(i, 5)
            b(k, 5) = a(i, 6)
            b(k, 6) = a(i, 7)
    End If
Next i



Sheets("bloods").Range("b4").Resize(UBound(a, 1), 6).Value = b


End Sub

Hi,

I tried the new code. Unfortunately it still keeps pasting the rows into the BLOODS sheet in the original order they were in on the MAIN LOG. I really need it to look for new additions (which may be near the top or bottom of the MAIN LOG and copy the new rows to the end of the BLOODS sheet, otherwise the manual notes in BLOODS Columns I to N just stay where they were and end up next to the wrong client.

Also, it's no longer populating Column H (Admin).

Any more suggestions please?

 

[RudRud]

How about this?

Book2
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
1	Current Days Waiting	Target Date	Current Status	Final Completion Time	clinic type	clinic date	Attended or DNA	clinician	Client no.	Client Name	D.o.b.	Date Dictated	Date Rosetted	Date Formatted	Formatted by(Admin Name)	Sign-Off Date	Date Sent	Bloods Requested
2	57	6/2/23	Complete	3	Neuro	6/2/23	Attended	Homer	101	Robert	1/1/10	1/1/10	1/1/10	1/1/10	a	b	c	Y
3	58	6/3/23	Complete	2	Dcd	6/3/23	Attended	R	102	Nobert	2/1/10	2/1/10	2/1/10	2/1/10	d	f	e
4	59	6/4/23	Complete	1	jac	6/4/23	Attended	weer	103	Sobert	3/1/10	3/1/10	3/1/10	3/1/10	a	b	c
5	60	6/5/23	Send	2	vd	6/5/23	Attended	Teres	104	Labert	4/1/10	4/1/10	4/1/10	4/1/10	d	f	e	Y
6	60	6/6/23	Pend	3	w	6/6/23	Attended	Fellex	107	Pabert	5/1/10	5/1/10	5/1/10	5/1/10	d	f	e
7	1	6/7/23	Complete	3	we	6/7/23	Attended	Salles	105	Wabert	6/1/10	6/1/10	6/1/10	6/1/10	a	b	c
8	2	6/8/23	Pend	4	r	6/8/23	Attended	Males	106	Sur	7/1/10	7/1/10	7/1/10	7/1/10	d	f	e	Y
9	2	6/8/23	Pend	4	r	6/8/23	Attended	Males	106	TES	7/1/10	7/1/10	7/1/10	7/1/10	d	f	e	Y
10	2	6/8/23	Pend	4	r	6/8/23	Attended	Males	106	Mrexcel	7/1/10	7/1/10	7/1/10	7/1/10	d	f	e	Y
MainLog

Book2
	A	B	C	D	E	F	G	H	I
1		C Details
2		Clinic Date	Clinic type	Clinician	NHS No	Client Name	Date of Birth	Bloods done	date of test
3		6/2/23	Neuro	Homer	101	Robert	1/1/10
4		6/5/23	vd	Teres	104	Labert	4/1/10
5		6/8/23	r	Males	106	Sur	7/1/10
6		6/8/23	r	Males	106	TES	7/1/10
7		6/8/23	r	Males	106	Mrexcel	7/1/10
Bloods

Sub test2()
Dim dict As New Dictionary
dict.CompareMode = TextCompare

c = Sheets("Bloods").Range("f3:f" & Cells(Rows.Count, "E").End(xlUp).Row).Value
For i = 1 To UBound(c, 1)
If Not dict.Exists(c(i, 1)) Then
    dict.Add c(i, 1), i
End If
Next i

With Sheets("MainLog")
a = .Range("e2:r" & .Cells(Rows.Count, "j").End(xlUp).Row).Value
End With

For i = 1 To UBound(a, 1)
    If Not dict.Exists(a(i, 6)) And UCase(a(i, 14)) = "Y" Then
        With Sheets("bloods")
           lrow = .Cells(Rows.Count, "f").End(xlUp).Row + 1
            .Cells(lrow, "b") = a(i, 2)
           .Cells(lrow, "c") = a(i, 1)
            .Cells(lrow, "d") = a(i, 4)
            .Cells(lrow, "e") = a(i, 5)
            .Cells(lrow, "f") = a(i, 6)
            .Cells(lrow, "g") = a(i, 7)
        End With
    End If
Next i
End Sub

 

[steve80s]

Hi, unfortunately, this new code gave me an error...

 

[RudRud]

Hi, unfortunately, this new code gave me an error...


View attachment 92782

Try tools - references find Microsoft Scripting Runtime and tick it

 

[steve80s]

Ok, that's working perfectly. Thank you. Last thing to do, can we automate the script to run any time something is entered into ROW R of the MAIN LOG please? As the other people using this form will not know how to run it.

 

[RudRud]

Hi @steve80s, Right Click MainLog -> View Code -> Paste the code below

The code will run automatically when user input "Y" in Mainlog sheets column R

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
    If Target.Column = 18 And UCase(Target.Value) = "Y" Then
    Call test2
    End If
End Sub

Sub test2()
Dim dict As New Dictionary
dict.CompareMode = TextCompare

c = Sheets("Bloods").Range("f3:f" & Cells(Rows.Count, "E").End(xlUp).Row).Value
For i = 1 To UBound(c, 1)
If Not dict.Exists(c(i, 1)) Then
    dict.Add c(i, 1), i
End If
Next i

With Sheets("MainLog")
a = .Range("e2:r" & .Cells(Rows.Count, "j").End(xlUp).Row).Value
End With

For i = 1 To UBound(a, 1)
    If Not dict.Exists(a(i, 6)) And UCase(a(i, 14)) = "Y" Then
        With Sheets("bloods")
           lrow = .Cells(Rows.Count, "f").End(xlUp).Row + 1
            .Cells(lrow, "b") = a(i, 2)
           .Cells(lrow, "c") = a(i, 1)
            .Cells(lrow, "d") = a(i, 4)
            .Cells(lrow, "e") = a(i, 5)
            .Cells(lrow, "f") = a(i, 6)
            .Cells(lrow, "g") = a(i, 7)
        End With
    End If
Next i

End Sub