VBA to merge rows if A:A is the same

[GazNicki]

Hi

I am looking for the VBA code needed to merge rows of data where the information in the A column is the same. Below is a Mini Sheet.

What I want the code to do is merge the rows where the data in A is the same. In the example below, you can see that NC2021-007 is found on row 8 and row 11. I would like these rows to merge leaving me with one single row which contains all the information.

Cells B to I will always be blank on the second instance of the repeated reference.
Cells K to Q will always be blank on the first instance of the repeated reference.
Cell A will be the only cell with the duplicated content, and should be replaced with the content from the second instance.

Non Conformance Tracker - 2021 (Table).xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1	Reference	Issue Name	Issue Date	Created by Name	Created By Email	Description	Severity	Person Responsible	PR Email	Deadline	NC Complete?	CA Taken	Date Complete	Completed By	Closed?	Review By	Date Closed
2	NC2021-001	Test 12	15/11/2021	Kerry Elford	Test@test.com	Testing yet again		Paul Bloor	Test@test.com	16/11/2021
3	NC2021-002	rvghbnjkm	19/11/2021	Sarah Sheldon	Test@test.com	gfhvbjnkm,llkjbhvg		Paul Bloor	Test@test.com	16/12/2021
4	NC2021-003	trfdvvs	15/10/2021	Marzena Dudek	Test@test.com	thfdsc		Kerry Elford	Test@test.com	21/10/2021
5	NC2021-004	Test New	22/10/2021	Gareth Parkinson	Test@test.com	This tests the Severity	High	Marzena Dudek	Test@test.com	12/12/2021
6	NC2021-005	Test	22/10/2021	Gareth Parkinson	Test@test.com	This is a test	High	Kerry Elford	Test@test.com	29/10/2021
7	NC2021-006	Test 2	22/10/2021	Gareth Parkinson	Test@test.com	This is just a Test	High	Marzena Dudek	Test@test.com	29/10/2021
8	NC2021-007	Final Test	22/10/2021	Marzena Dudek	Test@test.com	This is a test of the NC Report	High	Kerry Elford	Test@test.com	29/10/2021
9	NC2021-008	Testing, yet again	22/10/2021	Kerry Elford	Test@test.com	This is a test to ensure that the correct person receives the email.	Medium	Rod Ledgard	Test@test.com	05/11/2021
10	NC2021-009	FRIDAY	22/10/2021	Marzena Dudek	Test@test.com	FRIDAY - LETS GO HOME	Medium	Jimmy Winstanley	Test@test.com	05/11/2021
11	NC2021-007										Yes	This is the Corrective Action that has been fixed.	27/10/2021	Kerry Elford	Yes	Gareth Parkinson	27/10/2021
NC Log

Cell Formulas
Range	Formula
A2:A10	A2	=IF(C2="","",CONCATENATE("NC",TEXT(C2,"YYyy")&"-",LEFT("00",4-LEN(ROW(A2)-1)),ROW(A2)-1))
E11	E11	=IF(D11="","",VLOOKUP(D11,Table1,2,FALSE))
I11	I11	=IF(H11="","",VLOOKUP(H11,Table2,2,FALSE))

Named Ranges
Name	Refers To	Cells
'CA Form'!CreatedBy	=Table1[Created By (Name)]	E11
CreatedBy	=Table1[Created By (Name)]	E11
'CA Form'!PersonResponsible	=Table2[Responsible (Name)]	I11
PersonResponsible	=Table2[Responsible (Name)]	I11

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
G2:G99	Cell Value	contains "Low"	text	NO
G2:G99	Cell Value	contains "Medium"	text	NO
G2:G99	Cell Value	contains "High"	text	NO

 

[offthelip]

try this code, Note it doesn't delete the row, just the contents so you will end up with blanks rows. You didn't say which you wanted.

Sub test()
Dim tempr(1 To 1, 1 To 7) As Variant

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(lastrow, 17))

For i = 2 To lastrow - 1
 For j = i + 1 To lastrow
  If inarr(i, 1) = inarr(j, 1) Then
    For k = 1 To 7
     tempr(1, k) = inarr(j, 10 + k)
    Next k
    Range(Cells(i, 11), Cells(i, 17)) = tempr
    Range(Cells(j, 1), Cells(j, 17)) = ""
    Exit For
  End If
 Next j
Next i
End Sub

 

[GazNicki]

Thanks for this offthelip.

This worked perfectly, and I have been able to work with the additional row by incorporating a sort function then deleting empty rows.

Really appreciate the help, it's helped me close off another question as a workaround.