Excel macro that deletes rows randomly 2

[liltechy]

I have an Excel spreadsheet that is sent to me weekly. There are rows that need to be deleted and the sender changes the background color to yellow so that I know what rows not to delete the yellow rows. There are usually about 13,000 rows of data in this spreadsheet. The rows to be deleted are random. How do I accomplish this in a macro?

 

[kphu]

You can use a for loop to look thru each row.

There must be something that tells it to delete the row.

i.e. if the row is blank or if the row is green.

Give me more info and I'll write out a code for you.

 

[liltechy]

Only one cell will be yellow and I will need to delete the entire row if a random cell in the row is yellow. If the row does not have any cell that is yellow then it will not need to be deleted.

liltechy

 

[longhair]

liltechy,

Try this:
Sub delete()
Dim counter As Integer
counter = 0
Do Until counter = 25
counter = counter + 1
If ActiveCell.Interior.ColorIndex = 3 Or ActiveCell.Font.ColorIndex = 3 Then
Selection.EntireRow.delete
Else: ActiveCell.Offset(rowoffset:=1, columnoffset:=0).Activate
End If
Loop

End Sub
you just need to change the counter (always start off low so you don't loose too much) and adjust the color index for whatever color you need key on.

Regards,

longhair

 

[kphu]

Hi Longhair,

I'm looking at your code and it appears that the count will be excessive. Meaning that it'll count down from A1 then A2 then A3, etc. This tells me that it won't get to B1 until its gone to the last cell in column A before it comes back up to B1.

Here's a code that I've written out so that it doesn't go thru every cell in the worksheet. It'll take only the cells used in the worksheet.

The only problem with this code is that if it deletes a row it continues from the part that it takes off. Remind you that when the row is deleted the next row shifts up. Which means that if cell B4 is the current cell that is highlighted and the row would be deleted then row C4 will become row B4. Next i will continue from where B4 left off which is wrong because were now at a new row.

I'm trying to rewrite the code so that it can start from the beginning of that row again, however I only have another 10 mins to work on this and I'm out of the office tommorrow. Perhaps someone else can add to this code or edit it.

Sub deleterows()
Dim i As Integer
Dim r As Range
Set r = Intersect(ActiveSheet.UsedRange, Range("A1:E65536&quot) ' I assumed that the data will go up to column e, you can change this to whatever
i = 0
For i = 1 To r.Cells.Count
If ActiveCell.Interior.ColorIndex = 6 Or ActiveCell.Interior.ColorIndex = 27 Then 'not sure exactly which yellow is used but in the colorindex there's 2 possible values for yellow.
r.Cells(i).Select
Selection.EntireRow.Select
Selection.delete
Else
End If
Next i
End Sub

 

[liltechy]

I only want to delete the rows that Do Not have and interior color.

liltechy

 

[kphu]

liltechy,

Is the entire row's interior color filled in or just a random cell and within the row?

The answer to this would make it much more simple.

I assumed that you a random cell within the row is highlighted which represents that you don't want to delete the row.

As for you wanting t0 delete the row that does not have the interior color, that can be changed very easily with what was already written.

Sub deleterows()
Dim i As Integer
Dim r As Range
Set r = Intersect(ActiveSheet.UsedRange, Range("A1:E65536&quot) ' I assumed that the data will go up to column e, you can change this to whatever
i = 0
For i = 1 To r.Cells.Count
If ActiveCell.Interior.ColorIndex = 6 Or ActiveCell.Interior.ColorIndex = 27 Then 'not sure exactly which yellow is used but in the colorindex there's 2 possible values for yellow.
Else
r.Cells(i).Select
Selection.EntireRow.Select
Selection.delete
End If
Next i
End Sub

 

[lespaul]

If you are going to be deleting rows, it's better to start at the bottom!

Leslie
landrews@metrocourt.state.nm.us

There are 10 types of people in the world -
those who understand binary
and
those who don't!

 

[KenWright]

I posted the following in the Microsoft Office forum - Seems to work for the OP:-

Sub DelColouredRows()
Dim Cel As Range

For x = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
For Each Cel In ActiveSheet.UsedRange.Rows(x).Cells
If Cel.Interior.ColorIndex <> xlNone Then
Cel.EntireRow.Delete
End If
Next Cel
Next x
End Sub

Regards
Ken.............

 

[longhair]

kphu,

From the description of the issue I assumed entire row was changed, my bad for assuming. I also assumed to remove the colored row and keep normal row - just because that is how I normally approach. If there are no breaks in rows you could condense code and ...
do while activecell.value <> &quot;&quot;
but being that the spreadsheet comes from somone else and mistakes are always possible. Your concept and code are very efficient for the issue if it is a random cell within a row that could be colored different.

Regards,
longhair

 

[liltechy]

The entire row's interior is not filled, just random cells.

liltechy

 

[longhair]

liltechy,

I would use kphu's code. If it's helpful give him/her a star.

Regards,

longhair

 

[liltechy]

kphu,

Your code is great, but the rows I want to delete do not have any interior color. How do I set the code to delete those rows? Your code is looking at the interior being color 6.

liltechy

 

[xlbo]

Doesn't Ken's code work ???
Seems to me that it'd fir the bill nicely..

Rgds
Geoff
&quot;Some cause happiness wherever they go; others whenever they go.&quot;
-Oscar Wilde

 

[longhair]

liltechy,

On my machine default interior color is -4142.
To test on your's create the following macro
Sub test()
Dim x As Double
x = ActiveCell.Interior.ColorIndex
MsgBox (x)
End Sub
Navigate to a cell that you want to trigger your delete and then run this macro.

Regards,

longhair

 

[Loomah]

Hi
I was in agreement with xlbo's comment on Ken's code until I realised it deletes the rows that contain yellow cells. So adapting it quite heavily I came up with this.

This will romove all rows that DO NOT have any yellow cells.

Sub DelNON_ColouredRows()
Dim Cel As Range
Dim x As Long
Dim bolIsYell As Boolean
    For x = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
    bolIsYell = False
        For Each Cel In ActiveSheet.UsedRange.Rows(x).Cells
            If Cel.Interior.ColorIndex = 6 Or Cel.Interior.ColorIndex = 27 Then
                bolIsYell = True
                Exit For
            End If
        Next Cel
        If bolIsYell = False Then Rows(x).EntireRow.Delete
    Next x
End Sub

;-)

If a man says something and there are no women there to hear him, is he still wrong?

 

[liltechy]

Thanks, so much Loomah, it works great.

liltechy

 

[FaneDuru]

The KenWright's code is nice and simple. It deletes the rows having one cell with the coloured background. The request was oposite and I modified the code to work well:

Sub DelColouredRowsBis()
Dim Cel As Range, Del As Boolean
For x = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
Del = False
For Each Cel In ActiveSheet.UsedRange.Rows(x).Cells
If Cel.Interior.ColorIndex <> xlNone Then Del = True
Next Cel
If Del = False Then Cells(x, 1).EntireRow.Delete
Next x
End Sub

It works for any colour. If you wont to check only yelow background will change row &quot;If Cel.Interior.ColorIndex <> xlNone Then Del = True&quot; with &quot;If Cel.Interior.ColorIndex = 6 (or 36 is also yellow) Then Del = True&quot;

I hope it helps,
Fane Duru'