How to comparing two columns in excel, inserting blank rows moving associated data

How to compare two columns in excel, inserting blank rows moving associated data

Requirement:

The user has two lists each list has few columns and wants to match first list first column with second list first column and if they are not matching cells from each list insert blank line. For example:

List1			List2			Final result
11111	abc	hello	11111	abc	120	11111	abc	hello	11111	abc	120
11112	bcd	hi	11113	cdd	120	11112	bcd	hi
11114	ecd	right	11114	ecd	120				11113	cdd	120
11115	dde	wrong	11116	dff	120	11114	ecd	right	11114	ecd	120
11117	edfd	cell	11117	edfd	120	11115	dde	wrong
			11118	drek	120				11116	dff	120
						11117	edfd	cell	11117	edfd	120
									11118	drek	120

Solution:

Code:

Sub MatchColumns_Bis()

'First List Starts from A10 and ends at J10 (talking about first rows)
'Second List starts from L10 and ends W10 (talking about first rows)
'would like to paste in Y10.

Set coll = New Collection
ur1 = Cells(Rows.Count, 1).End(xlUp).Row
ur2 = Cells(Rows.Count, 12).End(xlUp).Row
Range("Y10:AX3000").ClearContents    'changed
On Error Resume Next
For i = 10 To ur1                 'changed
  coll.Add Cells(i, 1).Value, CStr(Cells(i, 1))
Next i
For i = 10 To ur2                 'changed
  coll.Add Cells(i, 12).Value, CStr(Cells(i, 12))
Next i
On Error GoTo 0
ReDim ordina(1 To coll.Count)
For i = 1 To coll.Count
  ordina(i) = coll(i)
Next i
For i = 1 To UBound(ordina) - 1
  For j = i + 1 To UBound(ordina)
    If ordina(i) > ordina(j) Then
      temp = ordina(i)
      ordina(i) = ordina(j)
      ordina(j) = temp
    End If
  Next j
Next i
a = 9                             'changed
For j = 1 To UBound(ordina)
  flg = 0
  For i = 10 To ur1               'changed
    If ordina(j) = Cells(i, 1) Then
      a = a + 1: flg = 1
      Range(Cells(i, 1), Cells(i, 10)).Copy Cells(a, 25)
    End If
  Next i
  If flg = 0 Then a = a + 1
Next j
a = 9                             'changed
For j = 1 To UBound(ordina)
  flg = 0
  For i = 10 To ur2               'changed
    If ordina(j) = Cells(i, 12) Then
      a = a + 1: flg = 1
      Range(Cells(i, 12), Cells(i, 23)).Copy Cells(a, 36)
    End If
  Next i
  If flg = 0 Then a = a + 1
Next j
End Sub

Obtained from the OzGrid Help Forum.

Solution provided by Marius44.