exclude zero value of the data in last row for each name

[Abdo]

Hi Guys,
I want to copy the data after the last row containing a zero for column G of each name of column C , and ignore all the data that precedes the last row with a zero for the same name , and if the last row contains a zero for column G for a specific name . if there are no data under it the last row with a zero , then it should be ignored and not copied But if there is absolutely no last row that contains a value of zero for a specific name, then all the data for the name is copied.
I put what I want in second sheet.
could be data about 6000 rows . now this will be simple as sample.

box1 (2).xlsm
	A	B	C	D	E	F	G
1	DATE	INVOICE NO	CLIENT NO	DESCRIBE	DEBIT	CREDIT	BALANCE
2	01/01/2022	-	ABDEND1	OPENNING	20000	-	20000
3	04/01/2022	PA-B3	ABDEND1	PA	20000	-	40000
4	05/01/2022	SA-B35	ABDEND1	SA	-	1000	39000
5	06/01/2022	SA-B36	ABDEND1	SA	-	39000	-
6	07/01/2022	PA-B3	ABDEND1	PA	1000	100	900
7	02/01/2022	PA-B36	ABDEND2	PA	1000	-	1000
8	07/01/2022	PA-B37	ABDEND2	PA	1000	-	2000
9	08/01/2022	SA-B37	ABDEND2	PA	-	2000	-
10	09/01/2022	PA-B38	ABDEND2	PA	1000	-	1000
11	10/01/2022	PA-B39	ABDEND2	PA	1500	-	2500
12	11/01/2022	PA-B40	ABDEND3	OPENNING	-	200	-200
13	12/01/2022	PA-B41	ABDEND3	PA	5000	-	4800
14	13/01/2022	PA-B42	ABDEND3	PA	5000	-	9800
15	14/01/2022	PA-B43	ABDEND3	PA	5000	-	14800
16	15/01/2022	PA-B44	ABDEND3	PA	2000	-	16800
17	16/01/2022	PA-B45	ABDEND3	PA	1000	100	17700
18	17/01/2022	SA-B38	ABDEND3	SA	-	17700	-
19	18/01/2022	PA-B46	ABDEND4	PA	1000	100	900
20	19/01/2022	PA-B47	ABDEND3	PA	2000	500	`1500
21	20/01/2022	PA-B48	ABDEND3	PA	2000	-	3500
22	21/01/2022	PA-B49	ABDEND4	PA	900	900	900
23	22/01/2022	PA-B50	ABDEND5	PA	200	-	200
24	23/01/2022	PA-B51	ABDEND6	PA	1200	200	1000
25	24/01/2022	PA-B52	ABDEND5	PA	200	400	-
26	25/01/2022	SA-B39	ABDEND6	SA	-	400	600
27	26/01/2022	PA-B53	ABDEND5	PA	220	220	-
28	27/01/2022	SA-B40	ABDEND6	SA	-	200	400
29	28/01/2022	PA-B54	ABDEND5	PA	220	20	200
30	29/01/2022	PA-B55	ABDEND7	PA	100		100
31	30/01/2022	PA-B56	ABDEND8	PA	200	-	200
32	31/01/2022	SA-B41	ABDEND7	SA	-	100	-
33	01/02/2022	SA-B42	ABDEND8	SA	-	200	-
34	02/02/2022	PA-B57	ABDEND9	PA	200	200	-
filter

Cell Formulas
Range	Formula
G2,G12,G7	G2	=E2-F2
G3,G13:G17,G8	G3	=G2+E3-F3

result

box1 (2).xlsm
	A	B	C	D	E	F	G
1	DATE	INVOICE NO	CLIENT NO	DESCRIBE	DEBIT	CREDIT	BALANCE
2	07/01/2022	PA-B3	ABDEND1	PA	1000	100	900
3	09/01/2022	PA-B38	ABDEND2	PA	1000	-	1000
4	10/01/2022	PA-B39	ABDEND2	PA	1500	-	2500
5	19/01/2022	PA-B47	ABDEND3	PA	2000	500	`1500
6	20/01/2022	PA-B48	ABDEND3	PA	2000	-	3500
7	18/01/2022	PA-B46	ABDEND4	PA	1000	100	900
8	21/01/2022	PA-B49	ABDEND4	PA	900	900	900
9	28/01/2022	PA-B54	ABDEND5	PA	220	20	200
10	23/01/2022	PA-B51	ABDEND6	PA	1200	200	1000
11	25/01/2022	SA-B39	ABDEND6	SA	-	400	600
12	27/01/2022	SA-B40	ABDEND6	SA	-	200	400
CLEAN

note: should sort name in second sheet from samll to big based on column C

 

[Alex Blakenburg]

Give this a try:
It assumes the sheet CLEAN already exists.
Change the sheet names to your sheet names.

Sub KeepOpenTransactions()

    Dim shtSrc As Worksheet, shtDest As Worksheet
    Dim srcRowLast As Long
    Dim srcRng As Range, destRng As Range
    Dim srcArr As Variant, destArr As Variant
    Dim i As Long, iKeepFlag As Long, totalKeep As Long, j As Long, k As Long
    
    Set shtSrc = Worksheets("filter")
    Set shtDest = Worksheets("CLEAN")
    
    With shtSrc
        srcRowLast = .Range("A" & Rows.Count).End(xlUp).Row
        Set srcRng = .Range("A1:G" & srcRowLast)
        srcArr = srcRng.Value2
        ReDim Preserve srcArr(1 To UBound(srcArr), 1 To UBound(srcArr, 2) + 1)
    End With
    
    Set destRng = shtDest.Range("A1")
    
    Dim dictSrc As Object, dictKey As String

    Set dictSrc = CreateObject("Scripting.dictionary")
    
    ' Load Client names into Dictionary and get highest row for Client with zero balance
    For i = 2 To UBound(srcArr)
        dictKey = srcArr(i, 3)
        If Not dictSrc.exists(dictKey) Then
            dictSrc(dictKey) = 0
        End If
        
        If srcArr(i, 7) = 0 Then
            dictSrc(dictKey) = i
        End If
    Next i
    
    ' Flag Source Array lines to keep
    srcArr(1, 8) = iKeepFlag        ' Keep Heading
    totalKeep = 1
    iKeepFlag = 1
    For i = 2 To srcRowLast
        dictKey = srcArr(i, 3)
        If i > dictSrc(dictKey) Then
            srcArr(i, 8) = iKeepFlag
            totalKeep = totalKeep + 1
        End If
    Next i

    ' Move lines to keep to output array
    ReDim destArr(1 To totalKeep + 1, 1 To UBound(srcArr, 2) - 1)
    For i = 1 To UBound(srcArr)
        If srcArr(i, 8) = 1 Then
            j = j + 1
            For k = 1 To UBound(destArr, 2)
                destArr(j, k) = srcArr(i, k)
            Next k
        End If
    Next i
    
    destRng.CurrentRegion.ClearContents
    Set destRng = destRng.Resize(j, UBound(destArr, 2))
    destRng.Value2 = destArr
    
    srcRng.Rows(2).Copy
    destRng.PasteSpecial Paste:=xlPasteFormats
    srcRng.Rows(1).Copy Destination:=destRng.Rows(1)
    destRng.Columns.AutoFit
    
    shtDest.Sort.SortFields.Clear
    destRng.Sort Key1:=destRng.Cells(1, 3), Order1:=xlAscending, Header:=xlYes
    
End Sub

 

[Abdo]

thanks
but there are two problems :
1-in sheet clean doesn't show row2 for client ABDEND1 as in pic2 , why?
2- should clear data for CLEAN sheet before brings data because will change data in FILTER sheet , then should update automatically in CLEAN sheet

 

[Abdo]

Hi Alex
did you see my post#3?

 

[Alex Blakenburg]

thanks
but there are two problems :
1-in sheet clean doesn't show row2 for client ABDEND1 as in pic2 , why?
2- should clear data for CLEAN sheet before brings data because will change data in FILTER sheet , then should update automatically in CLEAN sheet

1-in sheet clean doesn't show row2 for client ABDEND1 as in pic2 , why?
At the top of the Code change the A1 to A2 in this line:

    Set destRng = shtDest.Range("A2")

At the bottom of the code change the line in blue to what I have here:

    srcRng.Rows(2).Copy
    destRng.PasteSpecial Paste:=xlPasteFormats
    srcRng.Rows(1).Copy Destination:=destRng.Offset(-1).Rows(1)
    destRng.Columns.AutoFit
    
    shtDest.Sort.SortFields.Clear
    destRng.Sort Key1:=destRng.Cells(1, 3), Order1:=xlAscending, Header:=xlYes
    
End Sub

2- should clear data for CLEAN sheet before brings data because will change data in FILTER sheet , then should update automatically in CLEAN sheet
Why do you say that it doesn't ? This line in the existing code does that.

    destRng.CurrentRegion.ClearContents

 

[Abdo]

2- should clear data for CLEAN sheet before brings data because will change data in FILTER sheet , then should update automatically in CLEAN sheet
Why do you say that it doesn't ? This line in the existing code does that.

    destRng.CurrentRegion.ClearContents

My apologies !
I thought to doesn't work
now has fixed . thanks very much for your solution.

 

[Alex Blakenburg]

Thanks for letting me know. Glad I could help.