How to loop through a range and delete multiple rows at ones based on the value of a cell

[Bassie]

Hi,

I have a big dataset and at the moment we run the following code on it to remove all rows where column "BS" contains the value "Blue":

         For xx = Range(HeaderColor & Rows.Count).End(xlUp).Row To 1 Step -1 'Loop through range dynamically ("BS") at the moment
         If Cells(xx, Color.Column).Value = "Blue" Then Cells(xx, Color.Column).EntireRow.Delete 'If cells in this column = "Blue" delete entire row
         Next xx

This works but is incredibly slow as excel doesnt like removing rows in a big dataset, my solution would be to run the loop and instead of deleting the row to remember the row and do a single mass deletion at the end. Do you think this would work and if it would work how would I implement it?

Thanks a lot in advanced!
Bassie

 

[Legacy 143009]

Maybe something like this?

  Dim strRange As String
  For xx = Range(HeaderColor & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(xx, Color.Column).Value = "Blue" Then
         strRange = strRange & xx & ":" & xx & ","
    End If
  Next xx
  strRange = Left(strRange, Len(strRange) - 1)
  Range(strRange).Delete

 

[Bassie]

Maybe something like this?

  Dim strRange As String
  For xx = Range(HeaderColor & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(xx, Color.Column).Value = "Blue" Then
         strRange = strRange & xx & ":" & xx & ","
    End If
  Next xx
  strRange = Left(strRange, Len(strRange) - 1)
  Range(strRange).Delete

Hi thanks! I think it nearly works, at the moment I get a run-time 1004 error on running

Range(strRange).Delete

I already tried adding " " between every range but that also gives the same error.

The immediate window for strrange looks as follows:
"8457:8457","8456:8456","8455:8455","8454:8454","8453:8453","8452:8452","8451:8451","8450:8450","8449:8449","8448:8448","8447:8447","8446:8446","8445:8445","8444:8444","8443:8443","8442:8442","8441:8441","8440:8440","8439:8439","8438:8438","8437:8437","8436:8436","8435:8435","8434:8434","8433:8433","8432:8432","8431:8431","8430:8430","8429:8429","8428:8428","8427:8427","8426:8426","8425:8425","8424:8424","8423:8423","8422:8422","8421:8421","8420:8420","8419:8419","8418:8418","8417:8417","8416:8416","8415:8415","8414:8414","8413:8413","8412:8412","8411:8411","8410:8410","8409:8409","8408:8408","8407:8407","8406:8406","8405:8405","8404:8404","8403:8403","8402:8402","8401:8401","8400:8400","8399:8399","8398:8398","8397:8397","8396:8396","8395:8395","8394:8394","8393:8393","8392:8392","8391:8391","8390:8390","8389:8389","8388:8388","8387:8387","8386:8386","8385:8385","8384:8384","8383:8383","8382:8382","8381:8381","8380:8380","8379:8379","8378:8378","8377:8377","8376:8376","8375:8375","8374:8374","8373:8373","83
72:8372","8371:8371","8370:8370","8369:8369","8368:8368","8367:8367","8366:8366","8365:8365","8364:8364","8363:8363","8362:8362","8361:8361","8360:8360","8359:8359","8358:8358","8357:8357"

 

[Legacy 143009]

I already tried adding " " between every range but that also gives the same error.

No, you don't have to add " ".

Maybe it exceeds the number of arguments that Range() can handle. Maybe you should do in batches. I don't know..

 

[HaHoBe]

Hi Flasbond,

a string used in a range can only hold up to 255/256 characters.

@Bassie:

setting a range and adding to it might be a way (according to SpecialCells limit problem there should no longer be a problem with the number of cells) but I wonder if using AutoFilter and deleting the rows would not be faster. Or apply an Advanced Filter and exclude the rows in question to obtain the result without using VBA.

Ciao,
Holger

 

[Legacy 143009]

Based on Holger's information, please try the code below. This will shorten the string more than half. But I am not sure if it will work because I have no oppurtunity to test now.

Dim strRange As String
  For xx = Range(HeaderColor & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(xx, Color.Column).Value = "Blue" Then
         strRange = strRange & xx & ","
    End If
  Next xx
  strRange = Left(strRange, Len(strRange) - 1)
  Range(strRange).EntireRow.Delete

 

[Bassie]

Thanks guys! @Flashbond, @HaHoBe

I actually found a solution online.

For future reference:

For xx = temp.Range(HeaderColor & Rows.Count).End(xlUp).Row To 1 Step -1
              If Cells(xx, color.Column).Value = "Blue" Then
                Set deleterows = MakeUnion(deleterows, temp.Rows(xx))
                Else
                GoTo Endloop
            End If
        Next xx

Endloop:
If Not deleterows Is Nothing Then deleterows.Delete Shift:=xlUp

Public Function MakeUnion(Arg1 As Range, Arg2 As Range) As Range
   
    If Arg1 Is Nothing Then
        Set MakeUnion = Arg2
    ElseIf Arg2 Is Nothing Then
        Set MakeUnion = Arg1
    Else
        Set MakeUnion = Union(Arg1, Arg2)
    End If
End Function

Thanks anyways for your help, greatly appriciated :D