# Delete 100000 rows  based on matching  the value  for first row  with  last  row



## Maklil (Monday at 7:50 PM)

Hello
I   have  multiple ranges in Details sheet  if  the  second row (under header for each  range contains  value  is  the  same  value  where is  in lastrow(TOTAL)  in column E    or  the  lastrow(TOTAL)  contains zero  in column E then  should  delete the  ranges  , otherwise should  keep  the  rest
I  have  about  100000 rows  and  increasable .

Merging ranges_3.xlsbABCDE1DATECUSTOMERINV NOITEMQTY211/11/2000CSS-100INV-A123ITTT-100/AS-120031/7/2023CSS-100INV-A123ITTT-100/AS-110041/7/2023CSS-100INV-A123ITTT-100/AS-14051/7/2023CSS-100INV-A123ITTT-100/AS-1506TOTAL190789DATECUSTOMERINV NOITEMQTY1011/12/2000CSS-100INV-A123ITTT-100/AS-2300111/7/2023CSS-100INV-A123ITTT-100/AS-240012TOTAL400131415DATECUSTOMERINV NOITEMQTY1611/15/2000CSS-100INV-A124ITTT-100/AS-2600171/7/2023CSS-100INV-A124ITTT-100/AS-2300181/7/2023CSS-100INV-A124ITTT-100/AS-2100191/7/2023CSS-100INV-A124ITTT-100/AS-220020TOTAL600212223DATECUSTOMERINV NOITEMQTY2411/17/2000CSS-100INV-A129ITTT-100/AS-7800251/7/2023CSS-100INV-A129ITTT-100/AS-7500261/7/2023CSS-100INV-A129ITTT-100/AS-7200271/7/2023CSS-100INV-A129ITTT-100/AS-710028TOTAL0DETAILS
should be 
Merging ranges_3.xlsbABCDE1DATECUSTOMERINV NOITEMQTY211/11/2000CSS-100INV-A123ITTT-100/AS-120031/7/2023CSS-100INV-A123ITTT-100/AS-110041/7/2023CSS-100INV-A123ITTT-100/AS-14051/7/2023CSS-100INV-A123ITTT-100/AS-1506TOTAL190789DATECUSTOMERINV NOITEMQTY1011/12/2000CSS-100INV-A123ITTT-100/AS-2300111/7/2023CSS-100INV-A123ITTT-100/AS-240012TOTAL400OUTPUT


thanks


----------



## johnnyL (Monday at 9:25 PM)

Sorry, I don't understand what you are asking for based on your examples.


----------



## bebo021999 (Monday at 10:01 PM)

If I understood correctly. Loop through each non contiguous range in column E, then delete rows.
It employ a helper column (col ZZ in this sample) to help code faster.

```
Option Explicit
Sub delete()
Dim lr&, i&, area, fi As Range, se As Range
lr = Cells(Rows.Count, "A").End(xlUp).Row ' last used cell in column A
Set area = Range("E1:E" & lr).SpecialCells(xlCellTypeConstants, xlNumbers).Areas ' collection of non contiguous range
For i = 1 To area.Count ' loop thru each non contiguous range
    Set fi = area(i).Cells(1, 1): Set se = area(i).Cells(area(i).Count, 1) 'fi = first cell, se = last cell
    If fi.Value = se.Value Or se.Value = 0 Then
        Range(fi.Offset(-1, 0), se.Offset(2, 0)).Offset(, 697).Value = "x" ' input "x" into helper column "ZZ"
    End If
Next
With ActiveSheet.Range("A1:ZZ" & lr + 1)
    .AutoFilter field:=702, Criteria1:="x" ' filter column ZZ then delete rows with "x"
    .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.delete
    .AutoFilter
End With
End Sub
```


----------



## Maklil (Monday at 11:54 PM)

@johnnyL 
just  take  range  from row15:20   see  the  number  in  column E   from second row(ROW16)  the  number  is  600  and  the  lastrow in TOTAL (ROW20)  the  number is 600  then  it's  the  same  value  should  delete  the  whole  this  range .
as to 
range  from row23:28 see  the  number  in  column E   for   the  lastrow in TOTAL (ROW28)  the  number is 0 then  it's  the  should  delete  the  whole  this  range.


----------



## Peter_SSs (Tuesday at 12:09 AM)

With such large data and potentially many disjoint ranges to delete, I think that you should find this much faster.


```
Sub Del_Blocks()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, j As Long, k As Long, fr As Long, rws As Long
  Dim v As Double, tot As Double
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("E1", Range("E" & Rows.Count).End(xlUp).Offset(4)).Value
  a(UBound(a) - 1, 1) = "QTY"
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    Select Case a(i, 1)
      Case "QTY"
        If rws > 0 Then
          If a(i - 3, 1) = v Or a(i - 3, 1) = 0 Then
            For j = fr To fr + rws - 1
              k = k + 1
              b(j, 1) = 1
            Next j
          End If
        End If
        fr = i
        v = a(i + 1, 1)
        rws = 1
      Case Else
        rws = rws + 1
    End Select
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A1").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub
```

@bebo021999 
It is not a good idea to name a procedure the same as any word that vba already uses (eg "delete")


----------



## johnnyL (Tuesday at 12:10 AM)

Maklil said:


> @johnnyL
> just  take  range  from row15:20   see  the  number  in  column E   from second row(ROW16)  the  number  is  600  and  the  lastrow in TOTAL (ROW20)  the  number is 600  then  it's  the  same  value  should  delete  the  whole  this  range .


That part I totally get.



Maklil said:


> @johnnyL
> 
> as to
> range  from row23:28 see  the  number  in  column E   for   the  lastrow in TOTAL (ROW28)  the  number is 0 then  it's  the  should  delete  the  whole  this  range.


That is where I get lost.



> second row(ROW24)  the  number  is  800  and  the  lastrow in TOTAL (ROW28)  the  number is 0


 So why should that range be deleted? The second row column E doesn't = the total row column E in that range. ???


----------



## Maklil (Tuesday at 12:14 AM)

> So why should that range be deleted? The second row column E doesn't = the total row column E in that range. ???


Then  just  search  for  zero  in last  Total row  without  see the  second  row .


----------



## johnnyL (Tuesday at 12:18 AM)

Maklil said:


> Then  just  search  for  zero  in last  Total row  without  see the  second  row .



I must have missed the post where you previously mentioned:
If 2nd row Column E doesn't = the Total Row Column E, or the Total Row column E = 0 then ...


----------



## Maklil (Tuesday at 12:21 AM)

@bebo021999 
thanks  but  seem  to  be  slow  gives  about  20sec  and  should  show  in sheet OUTPUT    I want  keeping  the  orginal  data in DETAILS  sheet .


----------



## Maklil (Tuesday at 12:24 AM)

> If 2nd row Column E doesn't = the Total Row Column E, or the Total Row column E = 0 then ...


the  right  is :
If 2nd row Column E  = the Total Row Column E, or the Total Row column E = 0 then should  delete it


----------



## Maklil (Monday at 7:50 PM)

Hello
I   have  multiple ranges in Details sheet  if  the  second row (under header for each  range contains  value  is  the  same  value  where is  in lastrow(TOTAL)  in column E    or  the  lastrow(TOTAL)  contains zero  in column E then  should  delete the  ranges  , otherwise should  keep  the  rest
I  have  about  100000 rows  and  increasable .

Merging ranges_3.xlsbABCDE1DATECUSTOMERINV NOITEMQTY211/11/2000CSS-100INV-A123ITTT-100/AS-120031/7/2023CSS-100INV-A123ITTT-100/AS-110041/7/2023CSS-100INV-A123ITTT-100/AS-14051/7/2023CSS-100INV-A123ITTT-100/AS-1506TOTAL190789DATECUSTOMERINV NOITEMQTY1011/12/2000CSS-100INV-A123ITTT-100/AS-2300111/7/2023CSS-100INV-A123ITTT-100/AS-240012TOTAL400131415DATECUSTOMERINV NOITEMQTY1611/15/2000CSS-100INV-A124ITTT-100/AS-2600171/7/2023CSS-100INV-A124ITTT-100/AS-2300181/7/2023CSS-100INV-A124ITTT-100/AS-2100191/7/2023CSS-100INV-A124ITTT-100/AS-220020TOTAL600212223DATECUSTOMERINV NOITEMQTY2411/17/2000CSS-100INV-A129ITTT-100/AS-7800251/7/2023CSS-100INV-A129ITTT-100/AS-7500261/7/2023CSS-100INV-A129ITTT-100/AS-7200271/7/2023CSS-100INV-A129ITTT-100/AS-710028TOTAL0DETAILS
should be 
Merging ranges_3.xlsbABCDE1DATECUSTOMERINV NOITEMQTY211/11/2000CSS-100INV-A123ITTT-100/AS-120031/7/2023CSS-100INV-A123ITTT-100/AS-110041/7/2023CSS-100INV-A123ITTT-100/AS-14051/7/2023CSS-100INV-A123ITTT-100/AS-1506TOTAL190789DATECUSTOMERINV NOITEMQTY1011/12/2000CSS-100INV-A123ITTT-100/AS-2300111/7/2023CSS-100INV-A123ITTT-100/AS-240012TOTAL400OUTPUT


thanks


----------



## johnnyL (Tuesday at 12:28 AM)

Oops, you are right there. I said doesn't when I should have said does.


----------



## johnnyL (Tuesday at 12:36 AM)

Now that is solved, did you test @Peter_SSs code?


----------



## Maklil (Tuesday at 12:37 AM)

@Peter_SSs
your  code  is  too  fast  , awesome !
but  I  need   fixing  two  thing 
when  delete   some  ranges  , it  doesn't  delete  correctly  the  data  doesn't  become  arranged  !
Merging ranges_3.xlsbABCDE1DATECUSTOMERINV NOITEMQTY211/11/2000CSS-100INV-A123ITTT-100/AS-120031/7/2023CSS-100INV-A123ITTT-100/AS-110041/7/2023CSS-100INV-A123ITTT-100/AS-14051/7/2023CSS-100INV-A123ITTT-100/AS-1506TOTAL190789DATECUSTOMERINV NOITEMQTY1011/19/2000CSS-108INV-A131ITTT-100*12GF1000111/7/2023CSS-108INV-A131ITTT-100*12GF2121/7/2023CSS-108INV-A131ITTT-100*12GF213TOTAL4141516DATECUSTOMERINV NOITEMQTY1711/20/2000CSS-109INV-A132ITTT-100*12GF1100181/7/2023CSS-109INV-A132ITTT-100*12GF200191/7/2023CSS-109INV-A132ITTT-100*12GF2020TOTAL22021OUTPUT
second  the  data   should  show  OUTPUT  SHEET
to  see  closly   problem  formatting  after  delete  it   see   the  picture .


----------



## Peter_SSs (Tuesday at 12:45 AM)

Maklil said:


> data should show OUTPUT SHEET


OK, I will fix that. Does OUTPUT already exist in the workbook?
If so, can I delete it with the code and make a new one?




Maklil said:


> when delete some ranges , it doesn't delete correctly the data doesn't become arranged !


I don't understand that part. With your sample data from post #1 my code seemed to me to produce exactly what you showed as the output (apart from not being on a different sheet)
Can you give a small set of sample data where my code does not do what you want and also post the results that you do want for that sample data?


----------



## Maklil (Tuesday at 1:01 AM)

> Does OUTPUT already exist in the workbook?


yes


> If so, can I delete it with the code and make a new one?


Do  you  mean  making  new  code  from  scratch ?
it's  up  to   you buddy.


> my code seemed to me to produce exactly what you showed as the output (apart from not being on a different sheet)


yes  surley  without  any doubt  .
just  the  problem  is  relating  with  formatting  for  each  range  when  delete some  ranges  and  move  some  ranges  to  up  then the  formatting   becomes  untidy 
see the  picrure  before 



after  run  the  macro 




I  hope  this  help  you.


----------



## Peter_SSs (Tuesday at 1:40 AM)

Maklil said:


> then the formatting becomes untidy


From your 'before' picture it looks like the formatting *already is *untidy in that the blocks of data are not uniformly spaced with 2 blank rows between every block like there was in your post #1 sample. 
Is that the problem you are referring to?

My code simply deleted whole rows and leaves the remaining rows formatted as they were. If the issue is something other than the number of blank rows then I would think that the formatting problems must already be there.

In any case I can not do any testing with a picture so if there are other issues can you give a small sample with XL2BB that demonstrate those other issues?


----------



## Maklil (Tuesday at 3:17 AM)

just  when  I  posted  the  pictures  instead  of  using XL2BB  to  see  clearly  how  the  formatting was for  each  range  .
for  me   it  doesn't  seem  to  show  as  in  picture  when  using XL2BB  .
ok I  make  sure  there  are  spaced with 2 blank rows between every block like there was in your post #1 sample. even  if  that  the  problem still continues.
here  is orginal  data  before

Merging ranges_3.xlsbABCDE1DATECUSTOMERINV NOITEMQTY211/11/2000CSS-100INV-A123ITTT-100/AS-120031/7/2023CSS-100INV-A123ITTT-100/AS-130041/7/2023CSS-100INV-A123ITTT-100/AS-14051/7/2023CSS-100INV-A123ITTT-100/AS-1506TOTAL390789DATECUSTOMERINV NOITEMQTY1011/12/2000CSS-100INV-A123ITTT-100/AS-2300111/7/2023CSS-100INV-A123ITTT-100/AS-240121/7/2023CSS-100INV-A123ITTT-100/AS-25013TOTAL300141516DATECUSTOMERINV NOITEMQTY1711/15/2000CSS-100INV-A124ITTT-100/AS-2600181/7/2023CSS-100INV-A124ITTT-100/AS-2200191/7/2023CSS-100INV-A124ITTT-100/AS-240020TOTAL0212223DATECUSTOMERINV NOITEMQTY2411/17/2000CSS-100INV-A129ITTT-100/AS-7800251/7/2023CSS-100INV-A129ITTT-100/AS-790026TOTAL100272829DATECUSTOMERINV NOITEMQTY305/7/2003CSS-1000INV-A1030ITTT-100/AS-9022493311/7/2023CSS-1000INV-A1030ITTT-100/AS-9021000321/7/2023CSS-1000INV-A1030ITTT-100/AS-902400331/7/2023CSS-1000INV-A1030ITTT-100/AS-9021000341/7/2023CSS-1000INV-A1030ITTT-100/AS-9029335TOTAL2493363738DATECUSTOMERINV NOITEMQTY395/8/2003CSS-1001INV-A1031ITTT-100/AS-903249440TOTAL2494414243DATECUSTOMERINV NOITEMQTY445/9/2003CSS-1002INV-A1032ITTT-100/AS-904249545TOTAL2495464748DATECUSTOMERINV NOITEMQTY495/10/2003CSS-1003INV-A1033ITTT-100/AS-905249650TOTAL2496DETAILS

this  is  what  I got  after  run  the  macro
Merging ranges_3.xlsbABCDE1DATECUSTOMERINV NOITEMQTY211/11/2000CSS-100INV-A123ITTT-100/AS-120031/7/2023CSS-100INV-A123ITTT-100/AS-130041/7/2023CSS-100INV-A123ITTT-100/AS-14051/7/2023CSS-100INV-A123ITTT-100/AS-1506TOTAL390789DATECUSTOMERINV NOITEMQTY1011/17/2000CSS-100INV-A129ITTT-100/AS-7800111/7/2023CSS-100INV-A129ITTT-100/AS-790012TOTAL100OUTPUT

should  be
Merging ranges_3.xlsbABCDE1DATECUSTOMERINV NOITEMQTY211/11/2000CSS-100INV-A123ITTT-100/AS-120031/7/2023CSS-100INV-A123ITTT-100/AS-130041/7/2023CSS-100INV-A123ITTT-100/AS-14051/7/2023CSS-100INV-A123ITTT-100/AS-1506TOTAL390789DATECUSTOMERINV NOITEMQTY1011/17/2000CSS-100INV-A129ITTT-100/AS-7800111/7/2023CSS-100INV-A129ITTT-100/AS-790012TOTAL100OUTPUT


----------



## bebo021999 (Tuesday at 3:33 AM)

Again:

```
Option Explicit
Sub delRange()
Dim lr&, i&, j&, t&, seri, rng
Sheets("DETAILS").Copy after:=Sheets("DETAILS") ' dupplicate sheet DETAILS
If Evaluate("=ISREF(OUTPUT!A1)") Then Sheets("OUTPUT").Delete ' delete the old OUTPUT sheet
ActiveSheet.Name = "OUTPUT"
lr = Cells(Rows.count, "A").End(xlUp).Row
rng = Range("A1:F" & lr).Value
For i = 1 To UBound(rng) - 1
    rng(i, 6) = ""
    If rng(i, 1) = "DATE" Then
        For j = i + 1 To UBound(rng)
            If rng(j, 1) = "TOTAL" Then
                If rng(j, 5) <> 0 And rng(j, 5) <> rng(i + 1, 5) Then
                    For t = i To IIf(j >= UBound(rng), UBound(rng), j + 2)
                        seri = seri + 1
                        rng(t, 6) = seri
                    Next
                    i = j + 1
                End If
                Exit For
            End If
        Next
    End If
Next
With Range("A1").Resize(UBound(rng), 6)
    .Value = rng
    .Sort Range("F1")
End With
lr = Cells(Rows.count, "F").End(xlUp).Row
Range(Cells(lr + 1, 1), Cells(Rows.count, 1)).EntireRow.Delete
Columns("F").ClearContents
MsgBox "Done!"
End Sub
```


----------



## Alex Blakenburg (Tuesday at 3:44 AM)

I believe the issue is that the Borders don't move with the sort. The XL2BB does not include the borders so they are not in our test data.


----------



## Maklil (Tuesday at 3:46 AM)

@bebo021999
thanks again !
your  first  code does  every  thing  , the only  problem is  running speed .
the  second  code  is  very fast . the  only  problem   is  formatting
see this  picture  and  compare with  picture for  post#17 how should  be
Merging ranges_3.xlsbABCDE1DATECUSTOMERINV NOITEMQTY211/11/2000CSS-100INV-A123ITTT-100/AS-120031/7/2023CSS-100INV-A123ITTT-100/AS-110041/7/2023CSS-100INV-A123ITTT-100/AS-14051/7/2023CSS-100INV-A123ITTT-100/AS-1506TOTAL19078DATECUSTOMERINV NOITEMQTY911/12/2000CSS-100INV-A123ITTT-100/AS-2300101/7/2023CSS-100INV-A123ITTT-100/AS-240011TOTAL40012OUTPUT


----------



## Maklil (Monday at 7:50 PM)

Hello
I   have  multiple ranges in Details sheet  if  the  second row (under header for each  range contains  value  is  the  same  value  where is  in lastrow(TOTAL)  in column E    or  the  lastrow(TOTAL)  contains zero  in column E then  should  delete the  ranges  , otherwise should  keep  the  rest
I  have  about  100000 rows  and  increasable .

Merging ranges_3.xlsbABCDE1DATECUSTOMERINV NOITEMQTY211/11/2000CSS-100INV-A123ITTT-100/AS-120031/7/2023CSS-100INV-A123ITTT-100/AS-110041/7/2023CSS-100INV-A123ITTT-100/AS-14051/7/2023CSS-100INV-A123ITTT-100/AS-1506TOTAL190789DATECUSTOMERINV NOITEMQTY1011/12/2000CSS-100INV-A123ITTT-100/AS-2300111/7/2023CSS-100INV-A123ITTT-100/AS-240012TOTAL400131415DATECUSTOMERINV NOITEMQTY1611/15/2000CSS-100INV-A124ITTT-100/AS-2600171/7/2023CSS-100INV-A124ITTT-100/AS-2300181/7/2023CSS-100INV-A124ITTT-100/AS-2100191/7/2023CSS-100INV-A124ITTT-100/AS-220020TOTAL600212223DATECUSTOMERINV NOITEMQTY2411/17/2000CSS-100INV-A129ITTT-100/AS-7800251/7/2023CSS-100INV-A129ITTT-100/AS-7500261/7/2023CSS-100INV-A129ITTT-100/AS-7200271/7/2023CSS-100INV-A129ITTT-100/AS-710028TOTAL0DETAILS
should be 
Merging ranges_3.xlsbABCDE1DATECUSTOMERINV NOITEMQTY211/11/2000CSS-100INV-A123ITTT-100/AS-120031/7/2023CSS-100INV-A123ITTT-100/AS-110041/7/2023CSS-100INV-A123ITTT-100/AS-14051/7/2023CSS-100INV-A123ITTT-100/AS-1506TOTAL190789DATECUSTOMERINV NOITEMQTY1011/12/2000CSS-100INV-A123ITTT-100/AS-2300111/7/2023CSS-100INV-A123ITTT-100/AS-240012TOTAL400OUTPUT


thanks


----------



## Peter_SSs (Tuesday at 4:02 AM)

In post #17 you have an "after" image, then a "should be" image and then another image. What is that final image for?


----------



## Maklil (Tuesday at 4:29 AM)

> In post #17 you have an "after" image, then a "should be" image and then another image. What is that final image for?


should be


----------



## bebo021999 (Tuesday at 4:36 AM)

Ok, I see, Just remove this line:

```
rng(i, 6) = ""
```

Shoud become

```
Option Explicit
Sub delRange()
Dim lr&, i&, j&, t&, seri, rng
Sheets("DETAILS").Copy after:=Sheets("DETAILS") ' dupplicate sheet DETAILS
If Evaluate("=ISREF(OUTPUT!A1)") Then Sheets("OUTPUT").Delete ' delete the old OUTPUT sheet
ActiveSheet.Name = "OUTPUT"
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A1:F" & lr).Value
For i = 1 To UBound(rng) - 1
    'xxxxxxxxxxxxxxxxxxxx  remove this line
    'rng(i, 6) = ""
    'xxxxxxxxxxxxxxxxxxx
    If rng(i, 1) = "DATE" Then
        For j = i + 1 To UBound(rng)
            If rng(j, 1) = "TOTAL" Then
                If rng(j, 5) <> 0 And rng(j, 5) <> rng(i + 1, 5) Then
                    For t = i To IIf(j >= UBound(rng), UBound(rng), j + 2)
                        seri = seri + 1
                        rng(t, 6) = seri
                    Next
                    i = j + 1
                End If
                Exit For
            End If
        Next
    End If
Next
With Range("A1").Resize(UBound(rng), 6)
    .Value = rng
    .Sort Range("F1")
End With
lr = Cells(Rows.Count, "F").End(xlUp).Row
Range(Cells(lr + 1, 1), Cells(Rows.Count, 1)).EntireRow.Delete
Columns("F").ClearContents
MsgBox "Done!"
End Sub
```


----------



## Maklil (Tuesday at 4:55 AM)

@bebo021999  thanks
it  doesn't  seem  to  work !

as Alex said 


> The XL2BB does not include the borders so they are not in our test data.


then  should attach file  to  make  easy  matter .

Merging ranges.xlsb


----------



## shinigamilight (Tuesday at 5:22 AM)

```
Sub broder()
        Dim lr, k, store As Long
       
        lr = Cells.Find("*", Cells(1, 1), xlFormulas, xlWhole, xlByRows, xlPrevious, False).Row
       
        For k = lr To 1 Step -1
                    If Range("A" & k) = "TOTAL" Then
                        store = Range("E" & k)
                    End If
                
                     If Range("E" & k) = 0 And Range("E" & k) <> "" Then
                                Range("E" & k + 1).CurrentRegion.EntireRow.Delete xlUp
                                k = Range("E" & Rows.Count).End(xlUp).Row + 1
                                store = 0
                                GoTo nextit
                      End If
                 
                      If Range("E" & k) = "QTY" Then
                            If Range("E" & k + 1) = store Then
                                     Range("E" & k + 1).CurrentRegion.EntireRow.Delete xlUp
                                     store = 0
                                     k = Range("E" & Rows.Count).End(xlUp).Row + 1
                             End If
                    End If
nextit:
        Next k
       
           
End Sub
```


----------



## Peter_SSs (Tuesday at 5:36 AM)

This will not be as fast as my previous code, but see how it goes.


```
Sub Del_Blocks_v3()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, j As Long, k As Long, fr As Long, rws As Long
  Dim v1 As Double, v2 As Double

  Application.DisplayAlerts = False
  On Error Resume Next
  Sheets("OUTPUT").Delete
  On Error Resume Next
  Application.DisplayAlerts = True
  Sheets("DETAILS").Copy After:=Sheets("DETAILS")
  Sheets(Sheets("DETAILS").Index + 1).Name = "OUTPUT"
  With Sheets("OUTPUT")
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("E1", .Range("E" & Rows.Count).End(xlUp).Offset(2)).Value
    a(UBound(a) - 1, 1) = "QTY"
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      Select Case a(i, 1)
        Case "QTY"
          If rws > 0 Then
            If v1 = v2 Or v2 = 0 Then
              For j = fr To fr + rws - 1
                k = 1
                b(j, 1) = 1
              Next j
            End If
          End If
          fr = i
          v1 = a(i + 1, 1)
          rws = 1
        Case Else
          rws = rws + 1
          If a(i, 1) <> "" Then v2 = a(i, 1)
      End Select
    Next i
    If k > 0 Then
      Application.ScreenUpdating = False
      With .Range("A1").Resize(UBound(a), nc)
        .Columns(nc).Value = b
        .Columns(nc).SpecialCells(xlConstants).EntireRow.Delete
      End With
      Application.ScreenUpdating = True
    End If
  End With
End Sub
```


----------



## Maklil (Tuesday at 7:52 AM)

@shinigamilight 
very well , but  as  you  know  your  code works  with small  data  not  big  as  in title of  thread  and  details in OP.
thanks  very much


----------



## Maklil (Tuesday at 8:05 AM)

@Peter_SSs
this  is  really much  awesome !!


> This will not be as fast as my previous code, but see how it goes.


I no  know  if  you  agree with  me .  I don't find any significant difference
first code gives 0.430
second  code  gives 0.540
it  depends on efficiant  Laptop .
I  hope in the  future  the  tech team can improve XL2BB tool  until  show  formatting ,borders  instead of  capture picture to attached (the  picture doesn't  seem to  solve  the  problem  as  in  my case) .
many  thanks  for  you  and  the  others  guys  try  to  help  me .


----------



## Alex Blakenburg (Tuesday at 8:14 AM)

Maklil said:


> @Peter_SSs
> this  is  really much  awesome !!
> 
> I no  know  if  you  agree with  me .  I don't find any significant difference
> ...



Did you test it on real data or the sample you sent us ?
The sample you sent us only keeps the first few sections and deletes ALL the rest. What that means is that the row deletion is of a contiguous range and under those conditions it will be quite fast. The slowdown comes from having lots of non-contiguous rows to delete, which is why Peter generally suggests sorting the rows to be deleted together.


----------



## Maklil (Tuesday at 8:35 AM)

> Did you test it on real data or the sample you sent us ?


the sample I  sent  you .
what's  the  problem?
 my  real  data  should  be  the  same sample .


> The slowdown comes from having lots of non-contiguous rows to delete


I  don't  understand  it. what  I  know  the  ranges  should  contain two blank rows amongst for each other of them until doesn't  happen  the  problem  .


----------



## Maklil (Monday at 7:50 PM)

Hello
I   have  multiple ranges in Details sheet  if  the  second row (under header for each  range contains  value  is  the  same  value  where is  in lastrow(TOTAL)  in column E    or  the  lastrow(TOTAL)  contains zero  in column E then  should  delete the  ranges  , otherwise should  keep  the  rest
I  have  about  100000 rows  and  increasable .

Merging ranges_3.xlsbABCDE1DATECUSTOMERINV NOITEMQTY211/11/2000CSS-100INV-A123ITTT-100/AS-120031/7/2023CSS-100INV-A123ITTT-100/AS-110041/7/2023CSS-100INV-A123ITTT-100/AS-14051/7/2023CSS-100INV-A123ITTT-100/AS-1506TOTAL190789DATECUSTOMERINV NOITEMQTY1011/12/2000CSS-100INV-A123ITTT-100/AS-2300111/7/2023CSS-100INV-A123ITTT-100/AS-240012TOTAL400131415DATECUSTOMERINV NOITEMQTY1611/15/2000CSS-100INV-A124ITTT-100/AS-2600171/7/2023CSS-100INV-A124ITTT-100/AS-2300181/7/2023CSS-100INV-A124ITTT-100/AS-2100191/7/2023CSS-100INV-A124ITTT-100/AS-220020TOTAL600212223DATECUSTOMERINV NOITEMQTY2411/17/2000CSS-100INV-A129ITTT-100/AS-7800251/7/2023CSS-100INV-A129ITTT-100/AS-7500261/7/2023CSS-100INV-A129ITTT-100/AS-7200271/7/2023CSS-100INV-A129ITTT-100/AS-710028TOTAL0DETAILS
should be 
Merging ranges_3.xlsbABCDE1DATECUSTOMERINV NOITEMQTY211/11/2000CSS-100INV-A123ITTT-100/AS-120031/7/2023CSS-100INV-A123ITTT-100/AS-110041/7/2023CSS-100INV-A123ITTT-100/AS-14051/7/2023CSS-100INV-A123ITTT-100/AS-1506TOTAL190789DATECUSTOMERINV NOITEMQTY1011/12/2000CSS-100INV-A123ITTT-100/AS-2300111/7/2023CSS-100INV-A123ITTT-100/AS-240012TOTAL400OUTPUT


thanks


----------



## Alex Blakenburg (Tuesday at 7:34 PM)

When I run Peter's code on your sample data the items remaining are shown below and consists of 2 small ranges.
What this means is that although the size looks large at 40,445 rows 40,440 of the rows are contiguous that is they are a single block of rows (29 - 40,445) with nothing in between that needs to be kept.
Deleting a single block is not what makes deleting rows a slow process, deleting rows scattered throughout the data set is what is slow,
So unless this is actually the case in your live data, then using this to test performance is not going to give you a representative time.

Using your original Post #1 data and repeating it to fill 60k rows, it takes around 18 secs to run

Result after running the Macro on your sample data:

20230110 VBA Delete Non-Contiguous Formatted rows Maklil v05.xlsmABCDEFG1DATECUSTOMERINV NOITEMQTYOriginal Row No211/11/2000CSS-100INV-A123ITTT-100/AS-1200237/01/2023CSS-100INV-A123ITTT-100/AS-1300347/01/2023CSS-100INV-A123ITTT-100/AS-140457/01/2023CSS-100INV-A123ITTT-100/AS-15056TOTAL390677889DATECUSTOMERINV NOITEMQTY231017/11/2000CSS-100INV-A129ITTT-100/AS-780024117/01/2023CSS-100INV-A129ITTT-100/AS-79002512TOTAL1002613271428151617OUTPUT


----------



## Alex Blakenburg (Tuesday at 8:30 PM)

If you do discover the performance issue I am referring, try the code below.
It reduces the 18 secs on a more realistic set of data (60k rows) down to 5 and if you don't have any formulas in your "DETAIL" sheet you can swap out the Paste:=xlPasteFormulas with Paste:=xlPasteValues, which will reduce it to under 3 secs.

This is based on @Peter_SSs's post 5 which uses the sort method and relies on his very accurate flagging of the rows in a helper column with 1 for to be deleted and importantly Blank for to be retained. The code copies the formatting from the to be retained rows to the post deleted result in the Sheet output.

It works as far as I can tell. Let me know how it goes at your end.


```
Sub Del_Blocks_PeterPost5_withCopyBorders()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, j As Long, k As Long, fr As Long, rws As Long
  Dim v As Double, tot As Double
  Dim tm As Double
  tm = Timer
  
  With Sheets("DETAILS")
        nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
        a = .Range("E1", .Range("E" & Rows.Count).End(xlUp).Offset(2)).Value
        a(UBound(a) - 1, 1) = "QTY"
        ReDim b(1 To UBound(a), 1 To 1)
      For i = 1 To UBound(a)
        Select Case a(i, 1)
          Case "QTY"
            If rws > 0 Then
              If a(i - 3, 1) = v Or a(i - 3, 1) = 0 Then
                For j = fr To fr + rws - 1
                  k = k + 1
                  b(j, 1) = 1
                Next j
              End If
            End If
            fr = i
            v = a(i + 1, 1)
            rws = 1
          Case Else
            rws = rws + 1
        End Select
      Next i
        
      If k > 0 Then
        Application.ScreenUpdating = False
       
        Application.DisplayAlerts = False
        On Error Resume Next
        Sheets("OUTPUT").delete
        On Error Resume Next
        Application.DisplayAlerts = True
         
        With .Range("A1").Resize(UBound(a), nc)
          .Columns(nc).Value = b
          .Columns(nc).SpecialCells(xlBlanks).EntireRow.Copy
        End With
        
        Dim outSht As Worksheet
        Set outSht = Sheets.Add
        outSht.Name = "OUTPUT"
    
        With .Range("A1").Resize(UBound(a), nc)
            .Copy
            outSht.Range("A1").PasteSpecial Paste:=xlPasteFormulas
        End With
    
        
        With outSht.Range("A1").Resize(UBound(a), nc)
          .Range("A1").PasteSpecial Paste:=xlPasteFormats
          .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
          .Resize(k).EntireRow.delete
        End With
        
        With .Range("A1").Resize(UBound(a), nc)
            .Columns(nc).SpecialCells(xlBlanks).EntireRow.Copy
        End With
    
        outSht.Range("A1").PasteSpecial Paste:=xlPasteFormats
        .Columns(nc).ClearContents
        
        .Columns("A").Resize(, nc - 1).Copy
        Sheets("Output").Columns("A").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Application.ScreenUpdating = True
      End If
  End With
  MsgBox Format(Timer - tm, "0.00")
End Sub
```


----------



## Maklil (Tuesday at 11:36 PM)

@Alex Blakenburg 
thanks  for  clarification.
I  will  try  your  way  today  later and  inform  you  what happens.


----------



## bebo021999 (Tuesday at 11:54 PM)

Maklil said:


> @bebo021999  thanks
> it  doesn't  seem  to  work !


1) Below image is after code. Could you point the error out?








2) BTW, to dupplicate sheet without button, I use:

```
Application.CopyObjectsWithCells = False
'copy
Application.CopyObjectsWithCells = True
```

And the final code should be:

```
Option Explicit


Sub delRange()
Dim lr&, i&, j&, t&, seri, rng
Dim tm As Double
  tm = Timer
Application.CopyObjectsWithCells = False
Sheets("DETAILS").Copy after:=Sheets("DETAILS") ' dupplicate sheet DETAILS
If Evaluate("=ISREF(OUTPUT!A1)") Then Sheets("OUTPUT").Delete ' delete the old OUTPUT sheet
ActiveSheet.Name = "OUTPUT"
Application.CopyObjectsWithCells = True
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A1:F" & lr).Value
For i = 1 To UBound(rng) - 1
   If rng(i, 1) = "DATE" Then
        For j = i + 1 To UBound(rng)
            If rng(j, 1) = "TOTAL" Then
                If rng(j, 5) <> 0 And rng(j, 5) <> rng(i + 1, 5) Then
                    For t = i To IIf(j >= UBound(rng), UBound(rng), j + 2)
                        seri = seri + 1
                        rng(t, 6) = seri
                    Next
                    i = j + 1
                End If
                Exit For
            End If
        Next
    End If
Next
With Range("A1").Resize(UBound(rng), 6)
    .Value = rng
    .Sort Range("F1")
End With
lr = Cells(Rows.Count, "F").End(xlUp).Row
Range(Cells(lr + 1, 1), Cells(Rows.Count, 1)).EntireRow.Delete
Columns("F").ClearContents
MsgBox "Done!"
MsgBox Format(Timer - tm, "0.00")
End Sub
```


----------



## Maklil (Wednesday at 12:21 AM)

@bebo021999 
thanks nothing  changes .


> 1) Below image is after code. Could you point the error out?


didy  you  see  missed borders for  row3,4    and  the TOTAL row  border  becomes to  bottom in row7   and  add  wrong  border  in row2 ? the  right  way  as in  range row9:12 as in picture .  your  code makes the TOTAL row  border  to bottom .


----------



## Peter_SSs (Wednesday at 12:28 AM)

bebo021999 said:


> 1) Below image is after code. Could you point the error out?


Row 2 has a heavy border that should not be there.
Rows 3 and 4 do not have internal borders at all.
Row 7 has the heavy border that should be on row 6.
As Alex has pointed out the borders issue related to sorting.

_Edit: Oops, missed @Maklil post above so ignore my repetition above._

@Alex Blakenburg
I think that something is wrong with your code. Haven't looked at the cause in detail but I suspect it could relate to the fact that the initial blocks are not evenly spaced - see before image in post #15

In any case, I have found this alternative code faster than others suggested and retains formatting. At this stage I have assumed that original data has at least two blank rows between each block.


```
Sub Del_Blocks_v4()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, j As Long, k As Long, fr As Long, rws As Long
  Dim v1 As Double, v2 As Double
 
  Dim tm As Double
  tm = Timer
 
  Application.DisplayAlerts = False
  On Error Resume Next
  Sheets("OUTPUT").Delete
  On Error Resume Next
  Application.DisplayAlerts = True
  Sheets.Add(after:=Sheets("DETAILS")).Name = "OUTPUT"
  With Sheets("DETAILS")
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("E1", .Range("E" & Rows.Count).End(xlUp).Offset(2)).Value
    a(UBound(a) - 1, 1) = "QTY"
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      Select Case a(i, 1)
        Case "QTY"
          If rws > 0 Then
            If v1 <> v2 And v2 <> 0 Then
              For j = fr To fr + rws - 1
                k = k + 1
                b(j, 1) = 1
              Next j
            End If
          End If
          fr = i
          v1 = a(i + 1, 1)
          rws = 1
        Case vbNullString
          If a(i - 2, 1) <> "" Then rws = rws + 1
        Case Else
          v2 = a(i, 1)
          rws = rws + 1
      End Select
    Next i
    If k > 0 Then
      Application.ScreenUpdating = False
      With .Cells(1, nc).Resize(UBound(a))
        .Value = b
        .SpecialCells(xlConstants).EntireRow.Copy Destination:=Sheets("OUTPUT").Range("A1")
        .ClearContents
      End With
      Sheets("OUTPUT").Cells(1, nc).Resize(k).ClearContents
      Sheets("OUTPUT").UsedRange.EntireColumn.AutoFit
      Application.ScreenUpdating = True
    End If
  End With
  MsgBox Format(Timer - tm, "0.00")
End Sub
```

I used this sample data copied down 6,000 rows.

Maklil.xlsmABCDE1DATECUSTOMERINV NOITEMQTY211/11/2000CSS-100INV-A123ITTT-100/AS-120031/07/2023CSS-100INV-A123ITTT-100/AS-130041/07/2023CSS-100INV-A123ITTT-100/AS-14051/07/2023CSS-100INV-A123ITTT-100/AS-1506TOTAL200789DATECUSTOMERINV NOITEMQTY1011/12/2000CSS-100INV-A123ITTT-100/AS-2300111/07/2023CSS-100INV-A123ITTT-100/AS-240121/07/2023CSS-100INV-A123ITTT-100/AS-25013TOTAL01415161718DATECUSTOMERINV NOITEMQTY1911/15/2000CSS-100INV-A124ITTT-100/AS-2600201/07/2023CSS-100INV-A124ITTT-100/AS-2200211/07/2023CSS-100INV-A124ITTT-100/AS-240022TOTAL20232425DATECUSTOMERINV NOITEMQTY2611/17/2000CSS-100INV-A129ITTT-100/AS-7800271/07/2023CSS-100INV-A129ITTT-100/AS-790028TOTAL1002930313233DATECUSTOMERINV NOITEMQTY345/07/2003CSS-1000INV-A1030ITTT-100/AS-9022493351/07/2023CSS-1000INV-A1030ITTT-100/AS-9021000361/07/2023CSS-1000INV-A1030ITTT-100/AS-902400371/07/2023CSS-1000INV-A1030ITTT-100/AS-9021000381/07/2023CSS-1000INV-A1030ITTT-100/AS-9029339TOTAL2493404142DATECUSTOMERINV NOITEMQTY435/08/2003CSS-1001INV-A1031ITTT-100/AS-903249444TOTAL2494454647DATECUSTOMERINV NOITEMQTY485/09/2003CSS-1002INV-A1032ITTT-100/AS-904249549TOTAL249550515253545556DATECUSTOMERINV NOITEMQTY575/10/2003CSS-1003INV-A1033ITTT-100/AS-905249658TOTAL2005960DETAILS

Formatting of original sheet shown here





First part of my OUTPUT sheet shown here.


----------



## Maklil (Wednesday at 5:17 AM)

@Alex Blakenburg

just  question,  did  you  test  your  modfying?
it  doesn't  show  me  anything!
 if  I said  you  strange thing , do  you surprise from that?
in reality  when  test   the  data  contains  different count  rows  for  each  range whether  they  locates consecutively to   the bottom ( following one after another without an interruption or  not )the  code  becomes faster  than  before.
yesterday  gives  0.530 sec
today  gives 0.03 for two both codes post#26 & 36   from the  first  time,  after run  the  macro  more  than  one time    the  first will give 0.260 sec
second  give 0.110 sec

I  no  know  if  it's  relating for  LAPTOP's  memory .


----------



## Maklil (Wednesday at 5:34 AM)

@Peter_SSs

again thanks  for  new  version . I  can  depend on two codes
just  I have  problem about  autofit the  columns   width , some data  don't  show  clearly for the  last code   . I  have  to expanding columns width   manually . can  the  code  does  it  without  interfering  from me ?
date is  not  clear  and  data in column D

Merging ranges.xlsbABCDE1DATECUSTOMERINV NOITEMQTY2########CSS-100INV-A123ITTT-100/AS-120031/7/2023CSS-100INV-A123ITTT-100/AS-130041/7/2023CSS-100INV-A123ITTT-100/AS-14051/7/2023CSS-100INV-A123ITTT-100/AS-1506TOTAL390789DATECUSTOMERINV NOITEMQTY10########CSS-100INV-A129ITTT-100/AS-7800111/7/2023CSS-100INV-A129ITTT-100/AS-790012TOTAL100131415DATECUSTOMERINV NOITEMQTY16########CSS-1152INV-A1182ITTT-100/AS-1054264517########CSS-1153INV-A1183ITTT-100/AS-1055264618TOTAL2647192021DATECUSTOMERINV NOITEMQTY22########CSS-1411INV-A1441ITTT-100/AS-1313290423########CSS-1412INV-A1442ITTT-100/AS-1314290524########CSS-1413INV-A1443ITTT-100/AS-1315290625########CSS-1414INV-A1444ITTT-100/AS-1316290726########CSS-1415INV-A1445ITTT-100/AS-1317290827TOTAL29052829OUTPUT


----------



## Peter_SSs (Wednesday at 5:50 AM)

Maklil said:


> just I have problem about autofit the columns width ,


Just add this blue line of code where indicated near the end of the previous code.

```
Sheets("OUTPUT").Cells(1, nc).Resize(k).ClearContents
*Sheets("OUTPUT").UsedRange.EntireColumn.AutoFit*
Application.ScreenUpdating = True
```


----------



## Maklil (Wednesday at 5:57 AM)

@Peter_SSs  I bet this tread took much more time to solve it especially yesterday . 
thanks for your time and solution .


----------



## Maklil (Monday at 7:50 PM)

Hello
I   have  multiple ranges in Details sheet  if  the  second row (under header for each  range contains  value  is  the  same  value  where is  in lastrow(TOTAL)  in column E    or  the  lastrow(TOTAL)  contains zero  in column E then  should  delete the  ranges  , otherwise should  keep  the  rest
I  have  about  100000 rows  and  increasable .

Merging ranges_3.xlsbABCDE1DATECUSTOMERINV NOITEMQTY211/11/2000CSS-100INV-A123ITTT-100/AS-120031/7/2023CSS-100INV-A123ITTT-100/AS-110041/7/2023CSS-100INV-A123ITTT-100/AS-14051/7/2023CSS-100INV-A123ITTT-100/AS-1506TOTAL190789DATECUSTOMERINV NOITEMQTY1011/12/2000CSS-100INV-A123ITTT-100/AS-2300111/7/2023CSS-100INV-A123ITTT-100/AS-240012TOTAL400131415DATECUSTOMERINV NOITEMQTY1611/15/2000CSS-100INV-A124ITTT-100/AS-2600171/7/2023CSS-100INV-A124ITTT-100/AS-2300181/7/2023CSS-100INV-A124ITTT-100/AS-2100191/7/2023CSS-100INV-A124ITTT-100/AS-220020TOTAL600212223DATECUSTOMERINV NOITEMQTY2411/17/2000CSS-100INV-A129ITTT-100/AS-7800251/7/2023CSS-100INV-A129ITTT-100/AS-7500261/7/2023CSS-100INV-A129ITTT-100/AS-7200271/7/2023CSS-100INV-A129ITTT-100/AS-710028TOTAL0DETAILS
should be 
Merging ranges_3.xlsbABCDE1DATECUSTOMERINV NOITEMQTY211/11/2000CSS-100INV-A123ITTT-100/AS-120031/7/2023CSS-100INV-A123ITTT-100/AS-110041/7/2023CSS-100INV-A123ITTT-100/AS-14051/7/2023CSS-100INV-A123ITTT-100/AS-1506TOTAL190789DATECUSTOMERINV NOITEMQTY1011/12/2000CSS-100INV-A123ITTT-100/AS-2300111/7/2023CSS-100INV-A123ITTT-100/AS-240012TOTAL400OUTPUT


thanks


----------



## Peter_SSs (Wednesday at 6:00 AM)

You're welcome. Glad we got there in the end. 
(I have edited the marked solution to include that extra line to auto-fit the columns so the whole solution is together in one post)


----------

