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

[Maklil]

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.xlsb
	A	B	C	D	E
1	DATE	CUSTOMER	INV NO	ITEM	QTY
2	11/11/2000	CSS-100	INV-A123	ITTT-100/AS-1	200
3	1/7/2023	CSS-100	INV-A123	ITTT-100/AS-1	100
4	1/7/2023	CSS-100	INV-A123	ITTT-100/AS-1	40
5	1/7/2023	CSS-100	INV-A123	ITTT-100/AS-1	50
6	TOTAL				190
7
8
9	DATE	CUSTOMER	INV NO	ITEM	QTY
10	11/12/2000	CSS-100	INV-A123	ITTT-100/AS-2	300
11	1/7/2023	CSS-100	INV-A123	ITTT-100/AS-2	400
12	TOTAL				400
13
14
15	DATE	CUSTOMER	INV NO	ITEM	QTY
16	11/15/2000	CSS-100	INV-A124	ITTT-100/AS-2	600
17	1/7/2023	CSS-100	INV-A124	ITTT-100/AS-2	300
18	1/7/2023	CSS-100	INV-A124	ITTT-100/AS-2	100
19	1/7/2023	CSS-100	INV-A124	ITTT-100/AS-2	200
20	TOTAL				600
21
22
23	DATE	CUSTOMER	INV NO	ITEM	QTY
24	11/17/2000	CSS-100	INV-A129	ITTT-100/AS-7	800
25	1/7/2023	CSS-100	INV-A129	ITTT-100/AS-7	500
26	1/7/2023	CSS-100	INV-A129	ITTT-100/AS-7	200
27	1/7/2023	CSS-100	INV-A129	ITTT-100/AS-7	100
28	TOTAL				0
DETAILS

should be

Merging ranges_3.xlsb
	A	B	C	D	E
1	DATE	CUSTOMER	INV NO	ITEM	QTY
2	11/11/2000	CSS-100	INV-A123	ITTT-100/AS-1	200
3	1/7/2023	CSS-100	INV-A123	ITTT-100/AS-1	100
4	1/7/2023	CSS-100	INV-A123	ITTT-100/AS-1	40
5	1/7/2023	CSS-100	INV-A123	ITTT-100/AS-1	50
6	TOTAL				190
7
8
9	DATE	CUSTOMER	INV NO	ITEM	QTY
10	11/12/2000	CSS-100	INV-A123	ITTT-100/AS-2	300
11	1/7/2023	CSS-100	INV-A123	ITTT-100/AS-2	400
12	TOTAL				400
OUTPUT

thanks

 

[Peter_SSs]

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

 

[Maklil]

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]

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]

@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]

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]

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]

@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]

@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]

@Peter_SSs
this is really much awesome !!

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 .

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]

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 .