speeding up a loop

Can anyone suggest a more efficient way of ordering two columns so that the same values are on the same row?

column M has 16000 filled cells and column P has up to 50 filled cells, so my loop's really slow. For each cell in col P I need to move it to the p cell adjacent to its match in col M.

so I want:

1 2
2 7
3 9
4
5
6
7
8
9

to be:

1
2 2
3
4
5
6
7 7
8
9 9


Thanks!

Sub lloop()

Application.ScreenUpdating = False


Dim lcounter As Long

lcounter = 2 'set this to the first row number

Do While Range("M" & lcounter).Value <> "" And Range("P" & lcounter).Value <> ""
    If Range("M" & lcounter).Value <> Range("P" & lcounter) Then
        If Range("M" & lcounter).Value < Range("P" & lcounter) Then
            Range("P" & lcounter).Insert Shift:=xlDown
       
        End If
    End If
lcounter = lcounter + 1
Loop

Application.ScreenUpdating = True

End Sub

hi, menos, can you post sample workbook showing original data and result you need to get?

Hi Roger, thanks so much, that works a treat! So that I learn, can I check that I have interpreted the code correctly?

Set rng = Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row) 'define the cells that has the shorter col of data in it as a range called rng
   
rng2 = rng ' now store the values in rng in a new range called rng2

rng.ClearContents 'clear contents of the cells in rng

For i = 1 To UBound(rng2) ' for each value stored in rng2 call it i and ...
     j = WorksheetFunction.Match(rng2(i, 1), Columns(1), 0)  ' look for its exact match in col A and call that value j

Cells(j, "B") = Format(rng2(i, 1), "hh:mm:ss") ' the cell in col b at the row containing j is that value of i formatted as a time