copy lastrow for each name in range from sheet to another

[Abdo]

Hi
I want showing the lastrow for each name from sheet to another based on column C in sheet filter with ignore columns A,B,D
sheet filter

f .xlsm
	A	B	C	D	E	F	G
1	DATE	INVOICE NO	CLIENT NO	DESCRIBE	DEBIT	CREDIT	BALANCE
2	1/1/2022	-	ABDEND1	OPENNING	20,000.00	-	20,000.00
3	1/4/2022	PA-B3	ABDEND1	PA	20,000.00	-	40,000.00
4	1/5/2022	SA-B35	ABDEND1	SA	-	1,000.00	39,000.00
5	1/2/2022	PA-B36	ABDEND2	PA	1,000.00	-	1,000.00
6	1/7/2022	PA-B37	ABDEND2	PA	1,000.00	-	2,000.00
7	1/13/2022	PA-B45	ABDEND2	PA	1,000.00	100.00	2,900.00
8	1/3/2022	PA-B38	ABDEND3	openning	-	200.00	-200.00
9	1/6/2022	PA-B39	ABDEND3	PA	5,000.00	-	4,800.00
10	1/8/2022	PA-B40	ABDEND3	PA	5,000.00	-	9,800.00
11	1/9/2022	PA-B41	ABDEND3	PA	5,000.00	-	14,800.00
12	1/10/2022	PA-B42	ABDEND3	PA	2,000.00	-	16,800.00
13	1/11/2022	PA-B43	ABDEND3	PA	1,000.00	100.00	17,700.00
14	1/12/2022	PA-B44	ABDEND4	PA	1,000.00	100.00	900.00
filter

the result in sheet OUTPUT from row2 with the same borders & formatting . with considering any changing or adding new data in sheet filter should update in sheet output .

f.xlsm
	A	B	C	D	E
1	ITEM	CLIENT NO	DEBIT	CREDIT	BALANCE
2	1	ABDEND1	-	1,000.00	39,000.00
3	2	ABDEND2	1,000.00	100.00	2,900.00
4	3	ABDEND3	1,000.00	100.00	17,700.00
5	4	ABDEND4	1,000.00	100.00	900.00
output

thanks

 

[EXCEL MAX]

I hope this will run according to your expectation and that you will be able to set final format as you need.

Sub CreateReportUniqueLastRow()

   Dim vWS1 As Worksheet, vWS2 As Worksheet
   Dim vLastRow As String
   Dim vRng As Range, vRng1 As Range, _
            vRng2 As Range, vRng3 As Range, vR As Range
   Dim vN As Long
   Dim vAUnique As Variant, vA As Variant, vFind

   Application.ScreenUpdating = False
   Set vWS1 = Sheets("filter")
   Set vWS2 = Sheets("output")
   vLastRow = vWS1.Cells(Rows.Count, "C").End(xlUp).Address
   Set vRng = vWS1.Range("A2", vWS1.Range(vLastRow).Offset(, 4))
   Set vRng2 = vRng.Columns(3)
   With CreateObject("Scripting.Dictionary")
        For Each vR In vWS1.Range(vRng2.Address)
            If Not .exists(vR.Value) And Not vR.Value = "" Then _
               .Add vR.Value, ""
        Next vR
        vAUnique = Application.Transpose(.keys)
   End With
   Set vRng1 = Union(vWS1.Cells(1, 1), vWS1.Cells(1, 3), _
    vWS1.Cells(1, 5).Resize(, 3))
   vRng1.Copy vWS2.Cells(1, 1).Resize(, 5)
   ReDim vA(1 To UBound(vAUnique), 1 To 5)
   For vN = 1 To UBound(vAUnique)
      vFind = vRng.Columns(3).Find( _
         vAUnique(vN, 1), , , xlWhole, , xlPrevious, True).Row - 1
      vA(vN, 1) = vN
      vA(vN, 2) = vRng(vFind, 3)
      vA(vN, 3) = vRng(vFind, 5)
      vA(vN, 4) = vRng(vFind, 6)
      vA(vN, 5) = vRng(vFind, 7)
   Next vN
   vWS2.Range("A2").Resize(UBound(vAUnique), 5) = vA
   Set vRng3 = vWS2.Range("A2").Resize(UBound(vAUnique), 5)
'setting final format
   vRng3.Borders.LineStyle = vWS1.[A2].Borders.LineStyle
   vRng3.Interior.Color = vWS1.[A2].Interior.Color
   vRng3.VerticalAlignment = vWS1.[A2].VerticalAlignment
   vRng3.Font.Bold = vWS1.[A2].Font.Bold
   vRng3.Font.Size = vWS1.[A2].Font.Size
   vRng3.Font.Italic = vWS1.[A2].Font.Italic
   vRng3.Columns("C:E").NumberFormat = "0.00"
   vWS2.Columns("A:E").AutoFit
   vWS2.Columns("B").ColumnWidth = vWS1.Columns("C").ColumnWidth
   Application.ScreenUpdating = True

End Sub

 

[Abdo]

this is better gives 0.07 sec
thanks gain

 

[EXCEL MAX]

When you open workbook first time and goes to speed test,
code runs slowly, but second time it will runs faster.
Try to initiate code on "Workbook Open" event before test.

Private Sub Workbook_Open()
   CreateReportUniqueLastRow
   Sheets("output").Columns("A:E").Delete
End Sub

 

[Abdo]

I put it and save & close the file and when open the file gives compile error variable not defined for this word vFind in this line

 vFind = vRng.Columns(3).Find( _