Delete rows based on duplicate cell, but leaving first and last duplicate.

Hi guys, I have a problem which might seem simplistic,but its not ( for me at least ). I want to have a working macro that deletes a row based on the column cells 'P' which has only 1's and 2's in them. I want to have the macro keep the first '1' and the last '1' but delete all the '1's' in between, and then do the same for the '2's' and to make it even more complicated, every time the 1's change into a group of 2's the macro should keep the first '1' and last '1' again. This is difficult to explain, sorry.

Cannot attach a sample document,I am new to this site and it seems to throw out a error when I try uploading my excel sheet I'm working on.

Here is an an example of what I'm struggling for the code to-do.

Row---> Column P________________________________________New applied macro on rows
------------1____________________________________________ ------------1
------------1____________________________________________ -Deleted and shifted up row-
------------1____________________________________________ -Deleted and shifted up row-
------------1____________________________________________ ------------1
------------2____________________________________________ ------------2
------------2____________________________________________ -Deleted and shifted up row-
------------2____________________________________________ -Deleted and shifted up row-
------------2____________________________________________ ------------2
------------1____________________________________________ ------------1
------------1____________________________________________ -Deleted and shifted up row-
------------1____________________________________________ -Deleted and shifted up row-
------------1____________________________________________ ------------1

This is the macro code I am currently using that does not do exactly what I'm looking for but its a start.

Public Sub DeleteDuplicateRows()
 '
 ' This macro deletes duplicate rows in the selection. Duplicates are
 ' counted in the COLUMN of the active cell.
 
Dim Col As Integer
 Dim r As Long
 Dim C As Range
 Dim N As Long
 Dim V As Variant
 Dim Rng As Range
 
On Error GoTo EndMacro
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 
Col = ActiveCell.Column
 
If Selection.Rows.Count > 1 Then
 Set Rng = Selection
 Else
 Set Rng = ActiveSheet.UsedRange.Rows
 End If
 
N = 0
 For r = Rng.Rows.Count To 1 Step -1
 V = Rng.Cells(r, 1).Value
 If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
 Rng.Rows(r).EntireRow.Delete
 N = N + 1
 End If
 Next r
 
EndMacro:
 
Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 
End Sub

Thanks, I hope there is someone out there willing to help me with this, would truly appreciate it.

Will you always have 4 rows of the same type of data and 2 need to be deleted?

Did you try attaching the excel file this way?

1. Click on Go Advanced
2. In the frame Attach Files you will see the button Manage Attachments
3. Click the button.
4. A new window will open titled Manage Attachments - Excel Forum.
5. Click the Browse... button to locate your file for uploading.
6. This will open a new window File Upload.
7. Once you have located the file to upload click the Open button. This window will close.
8. You are now back in the Manage Attachments - Excel Forum window.
9. Click the Upload button and wait until the file has uploaded.
10. Close the window and then click Submit.