repeat post

[Gareth]

Firstly, apologies for asking the same question again but I was afraid that
I might of been forgotten.

From the question below you will see that I onlty want to delete rows which
have an MS in the range P:T, the code that Dianne suuplied deletes the row
if MS exists with any other code.

many thanks

Gareth

--------------------------------
Dianne

Thanks for this but perhaps I didn't ask the question properly:

I only want the row deleted if MS is the only entry in the range, your code
deletes any row containing MS in the range.

Help........

 

[Ron de Bruin]

Try something like this

Private Sub Test()
Dim r As Long
Application.ScreenUpdating = False
With Worksheets("Sheet1")
For r = .UsedRange.Rows(.UsedRange.Rows.Count).Row To 1 Step -1
If Application.CountIf(Range(Cells(r, "P"), Cells(r, "T")), "MS") > 0 Then
.Rows(r).Delete
End If
Next
End With
Application.ScreenUpdating = True
End Sub

 

[Tom Ogilvy]

For lngRow = lngLastRow To 1 Step -1
' check that only one cell in columns P to T contains a value
if Application.CountA(cells(lngRow,16).Resize(1,4)) = 1 then
For intCounter = 16 To 20 ' check P to T
' check if singe cell with value contains MS and only MS
If Trim(Cells(lngRow, intCounter).Value) = "MS" Then
' a row with MS and only MS in P to T
Rows(lngRow).EntireRow.Delete
Exit For
End If
Next intCounter
End If
Next lngRow

 

[Tom Ogilvy]

That would still delete a row that had other codes in addition to MS.

Maybe with the added code:

Private Sub Test()
Dim r As Long
Dim r1 as Range
Application.ScreenUpdating = False
With Worksheets("Sheet1")

For r = .UsedRange.Rows(.UsedRange.Rows.Count).Row To 1 Step -1
set r1 = .Range(.Cells(r, "P"), .Cells(r, "T"))
If Application.CountIf(r1,"MS") =1 and Application.CountA(r1) =
1 Then
.Rows(r).Delete
End If
Next
End With
Application.ScreenUpdating = True
End Sub

If a row with multiple MS codes is to be deleted, then change =1 to >1 for
the first condition.

 

[Ron de Bruin]

Oops

I misread

 

[Gareth]

Tom

Many thanks, just the job.....

I have remembered something else though....

The sheet is made up of duplicated rows of data, the only difference between
the rows being the addition of any codes in P:T.

Your code deletes any MS only rows of data, but I need it to also delete the
same row without the code. Both rows will have the same ID number in column
A

Is there a way to find MS only codes and then delete any rows with the same
value in column A?

PS
There will be occasions when an MS code doesn't have a duplicate row.

Gareth
{clear as mud}

 

[Tom Ogilvy]

If the entry in column A matches the entry in column A for a row that was
deleted, it (the row) is deleted - no check on codes in P:T for the what
codes they have (they would already have failed that test). That is what I
understood you to want.

Public Sub Test()
Dim r As Long
Dim r1 As Range
Dim lrw As Long
Dim list As Variant
Dim rng As Range
Application.ScreenUpdating = False
With Worksheets("Sheet1")
lrw = .UsedRange.Rows(.UsedRange.Rows.Count).Row
ReDim list(1 To lrw)
icnt = 0
For r = lrw To 1 Step -1
Set r1 = .Range(.Cells(r, "P"), .Cells(r, "T"))
If Application.CountIf(r1, "MS") = 1 And _
Application.CountA(r1) = 1 Then
icnt = icnt + 1
list(icnt) = .Cells(r, 1).Value
.Rows(r).Delete
End If
Next

ReDim Preserve list(1 To icnt)
For i = 1 To icnt
.Columns(1).Replace What:=list(i), _
Replacement:="=na()", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False
Next
On Error Resume Next
Set rng = Columns(1).SpecialCells(xlFormulas, xlErrors)
On Error GoTo 0
If Not rng Is Nothing Then
rng.EntireRow.Delete
End If
End With
Application.ScreenUpdating = True
End Sub