Hi
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 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 the result in accounts sheet for the file 2023 and import from filter sheet for BOX1 file . should replace data every time run the macro .
here is Marc L's code works in the same file in CLEAN sheet( but delete clean sheet to implement in other file ) .
Option Explicit
Sub Demo1()
Const C = "CLEAN", S = "-"
Dim Rf(1) As Range, F%(), R&, L&
Sheets(C).UsedRange.Offset(1).Clear
With [A1].CurrentRegion.Resize(, 8).Columns
Set Rf(0) = .Item(7).Find(S, , xlValues, 1, , 1)
If Not Rf(0) Is Nothing Then
ReDim F(1 To .Rows.Count, 0)
R = Rf(0).Row
Do
L = Rf(0).Row
F(L, 0) = 1
Set Rf(1) = .Item(3).Find(Rf(0)(1, -3), Rf(0)(1, -3), , , , 2)
While Rf(1).Row < L And Rf(1)(1, 5)
F(Rf(1).Row, 0) = 1
Set Rf(1) = .Item(3).FindPrevious(Rf(1))
Wend
Set Rf(0) = .Item(7).Find(S, Rf(0), , , , 1)
Loop Until Rf(0).Row = R
Erase Rf
Union(.Item(8), [I1:I2]).Font.ColorIndex = 2
.Item(8) = F
[I1:I2] = 0
.AdvancedFilter 2, [I1:I2], Sheets(C).[A1:G1]
Union(.Item(8), [I1:I2]).Clear
End If
End With
End Sub
Bookmarks