PDA

View Full Version : [SOLVED] Delete any row which does not have any cells which are conditionally formatted



1819
01-13-2017, 07:13 AM
I have a worksheet where some cells are conditionally formatted. There is no pattern to the formatting.

Using code, I want to be able to delete any row which does NOT have a cell which is conditionally formatted.

(There are plenty of suggestions on the internet about how to delete conditionally formatted rows. But I can't find a solution to the reverse).

Many thanks.

Paul_Hossler
01-13-2017, 08:26 AM
.SpecialCells is your friend




Option Explicit

Sub DeleteNonCF()
Dim rCF As Range, rData As Range, rDataRow As Range

Set rData = ActiveSheet.Cells(1, 1).CurrentRegion
Set rCF = rData.SpecialCells(xlCellTypeAllFormatConditions)

If rCF Is Nothing Then Exit Sub

Application.ScreenUpdating = False

For Each rDataRow In rData.Rows
If Not Intersect(rDataRow, rCF) Is Nothing Then
rDataRow.Cells(1, 1).Value = True
End If
Next

On Error Resume Next
rData.Columns(1).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
On Error GoTo 0
Application.ScreenUpdating = True

End Sub

1819
01-17-2017, 07:33 AM
Paul

Many thanks. I think this line:



rData.Columns(1).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete

is causing the rows to be deleted if column A is not conditionally formatted.

Unfortunately I want to keep rows where, say, column C is conditionally formatted and column A is not.

There are 8 columns in total.

Any advice as to how to delete rows except those where one of the columns is conditionally formatted?

Thanks.

Paul_Hossler
01-17-2017, 09:05 AM
Any advice as to how to delete rows except those where one of the columns is conditionally formatted?


Exactly one column, or ANY column?

This does ANY column



Change the one line to this




If Intersect(rDataRow, rCF) Is Nothing Then


a. If any cell in the row is in the block of conditionally formatted cells, then the Intersection is not Nothing

b. If there are no row cells in the CF range of cells on the sheet, then the Intersection is Nothing

c. If the Intersection is Nothing (no cells in the row that are in the CF range) mark column A




Option Explicit

Sub DeleteRowsWithNoCFcell()
Dim rCF As Range, rData As Range, rDataRow As Range

Set rData = ActiveSheet.Cells(1, 1).CurrentRegion
Set rCF = rData.SpecialCells(xlCellTypeAllFormatConditions)

If rCF Is Nothing Then Exit Sub

Application.ScreenUpdating = False

For Each rDataRow In rData.Rows
If Intersect(rDataRow, rCF) Is Nothing Then
rDataRow.Cells(1, 1).Value = True
End If
Next

On Error Resume Next
rData.Columns(1).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
On Error GoTo 0
Application.ScreenUpdating = True

End Sub

1819
01-17-2017, 09:26 AM
Thanks Paul. Your code works well on the sample file you attached.

Unfortunately it's not working on my data.

Could it be because I am using the code on text, not numbers?

Paul_Hossler
01-17-2017, 09:49 AM
Thanks Paul. Your code works well on the sample file you attached.

Unfortunately it's not working on my data.

Could it be because I am using the code on text, not numbers?


Hmmm....

Text vs Numbers should not make a difference

Can you post a small example workbook with a representative sample of data (fake data if necessary) and indicate the cells / rows that are incorrect?

1819
01-17-2017, 10:46 AM
Paul

Here's a dummy file as suggested. The data was copied in from Outlook emails - not sure if that makes any difference. It doesn't seem to be HTML.

Thanks.

18055

Paul_Hossler
01-17-2017, 12:30 PM
Thanks -- that helps a lot

The issue is that the cells (E5 for example) do have CF rules, it's just that there is no defined value (like TD) that triggers the conditional formatting to display


18057

SO --- if your intent was to delete the lines with the orange names in the picture, you'll have to come up different criteria

There is probably a way read the CF, but way too complicated if there's a different way, like a complete least of values in the date columns that would cause the row to be NOT deleted

Paul_Hossler
01-17-2017, 01:45 PM
Play with this maybe

I changed your CF rules to just look in Col Z for a list

The macro uses a list of values to determine to leave the row or not: If any cell in the row is in the list, leave the row, otherwise delete the row

Instead of deleting the row, for now I just marked it in red

You can UNCOMMENT the 2 lines

18058




Option Explicit

Sub GetAbsenceTables()
Dim rData As Range, rDataRow As Range, rCell As Range
Dim aMatch As Variant, aRow As Variant
Dim i As Long
Dim sRow As String


aMatch = Array("TD", "SL", "UL", "Spl", "CL", "PL", "SCD", "SSC", "WFH")

Application.ScreenUpdating = False

Set rData = ActiveSheet.Cells(1, 1).CurrentRegion

For Each rDataRow In rData.Rows
With rDataRow
aRow = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Trans pose(.Cells.Value))
sRow = Join(aRow, ",")
For i = LBound(aMatch) To UBound(aMatch)
If InStr(sRow, aMatch(i)) > 0 Then GoTo KeyWordInRow
Next i

'no key words in row
'if Col A is not a breaker line then mark it TRUE to be deleted
If .Cells(1, 1).Value <> "DEPARTMENT" And .Cells(1, 1).Value <> "Name" Then
'UNCOMMENT .Cells(1, 1).Value = True
.Cells(1, 1).Interior.Color = vbRed
End If

End With


KeyWordInRow:
Next


On Error Resume Next
'UNCOMMENT rData.Columns(1).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
On Error GoTo 0
Application.ScreenUpdating = True

End Sub

1819
01-17-2017, 02:09 PM
That's fantastic Paul. I was just trying to follow similar logic - colour cells and use an array - but was failing miserably.

Thank you so much!

Paul_Hossler
01-17-2017, 02:55 PM
OK

I don't really think that you need to use conditional formatting for what I think you need to do

Also my coloring was just for testing to mark the rows. For production, you can UNCOMMENT the two lines, and delete the = vbRed one

1819
01-18-2017, 05:13 AM
Yes, you are right Paul. But it seems to work as you set out, and this will make my HR colleagues very happy.