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.
Bookmarks