extract data from the lastrow contains specific word based on date today

[abdo meghari]

Hello
I want to extract data for specific information with the formatting as in original sheets as I did it in REPORT sheet
I want to extract for the DATE and INV.NO,TOTAL from each row contains SUM word based on date today .
so in REPORT sheet should create sheet name in above as I did it and make separated range for each sheet and sum the whole amounts for TOTAL column .

SS.xlsm
	A	B	C	D	E	F	G	H	I
1	ITEM	DATE	INV.NO	BRAND	TYPE	ORIGIN	QTY	PRICE	TOTAL
2	1	2023/06/10	BSJ_23444	BS 215/60R16	ER30	JAP	4.00	430.00	1,720.00
3	SUM	2023/06/10	BSJ_23444						1,720.00
4	1	2023/06/10	BSJ_23445	GO 1200R20	AZ0026	CHI	2.00	955.00	1,910.00
5	SUM	2023/06/10	BSJ_23445						1,910.00
6	1	2023/09/15	BSJ_23446	GO 1200R20	AZ0026	CHI	2.00	950.00	1,900.00
7	2	2023/09/15	BSJ_23446	GO 1200R21	AZ0027	CHI	3.00	1,000.00	3,000.00
8	SUM	2023/09/15	BSJ_23446						4,900.00
9	1	2023/09/15	BSJ_23447	BS 1200R20	G580	JAP	1.00	2,000.00	2,000.00
10	2	2023/09/15	BSJ_23447	BS 1200R20	G580	THI	1.00	2,000.00	2,000.00
11	3	2023/09/15	BSJ_23447	BS 1200R20	R187	THI	1.00	2,000.00	2,000.00
12	SUM	2023/09/15	BSJ_23447						6,000.00
SR

SS.xlsm
	A	B	C	D	E	F	G	H	I
1	ITEM	DATE	INV.NO	BRAND	TYPE	ORIGIN	QTY	PRICE	TOTAL
2	1	2023/06/15	BSTR_23448	BS 750R16	R230	JAP	4.00	500.00	2,000.00
3	2	2023/06/15	BSTR_23448	BS 700R16	R230	JAP	2.00	400.00	800.00
4	SUM	2023/06/15	BSTR_23448						2,800.00
5	1	2023/09/15	BSTR_23449	GO 1200R20	AZ0026	CHI	1.00	920.00	920.00
6	2	2023/09/15	BSTR_23449	GO 1200R20	AZ0083	CHI	2.00	1,000.00	2,000.00
7	SUM	2023/09/15	BSTR_23449						2,920.00
8	1	2023/09/15	BSTR_23450	BS 1200R20	G580	JAP	1.00	1,800.00	1,800.00
9	2	2023/09/15	BSTR_23450	BS 1200R20	G580	THI	1.00	1,800.00	1,800.00
10	3	2023/09/15	BSTR_23450	BS 1200R20	R187	THI	1.00	1,800.00	1,800.00
11	SUM	2023/09/15	BSTR_23450						5,400.00
SVR

result should be

المصنف2.xlsm
	A	B	C	D
1		SR
2	ITEM	DATE	INV.NO	TOTAL
3	1	2023/09/15	BSJ_23446	4,900.00
4	2	2023/09/15	BSJ_23447	6,000.00
5	SUM			10,900.00
6
7
8		SVR
9	ITEM	DATE	INV.NO	TOTAL
10	1	2023/09/15	BSTR_23449	2,920.00
11	2	2023/09/15	BSTR_23450	5,400.00
12	SUM			8,320.00
REPORT

Cell Formulas
Range	Formula
D5,D12	D5	=SUM(D3:D4)

notice : my real data could be 6000 rows for each sheet and every time I will add and change data in others sheets then should delete data in REPORT sheet before brings data when every time run the macro .
thanks

 

[DanteAmor]

Try this

Sub Report()
  Dim sh1 As Worksheet
  Dim sh As Variant, arrsh As Variant, a() As Variant
  Dim i, s1&, s2&, k&, n&, lr&
  Dim nTotal As Double
  Dim f As Range
  Dim cell As String, wcolor As Variant, wcolor2 As Variant
    
  Set sh1 = Sheets("SR")
  wcolor = sh1.Range("A1").Interior.Color
  wcolor2 = sh1.Range("A:A").Find("SUM", , xlValues, xlWhole).Interior.Color
  
  For Each sh In Array("SR", "SVR")
    s1 = s1 + WorksheetFunction.CountIfs(Sheets(sh).Range("A:A"), "SUM", Sheets(sh).Range("B:B"), Date)
  Next
  ReDim c(1 To s1 + 8, 1 To 4)
  k = 1
  
  For Each sh In Array("SR", "SVR")
    c(k, 2) = sh
    c(k + 1, 1) = "ITEM"
    c(k + 1, 2) = "DATE"
    c(k + 1, 3) = "INV.NO"
    c(k + 1, 4) = "TOTAL"
    k = k + 2
    n = 1
    nTotal = 0
    Erase a
    a = Sheets(sh).Range("A2", Sheets(sh).Range("I" & Rows.Count).End(3)).Value
  
    For i = 1 To UBound(a, 1)
      If a(i, 1) = "SUM" And a(i, 2) = Date Then
        c(k, 1) = n
        c(k, 2) = a(i, 2)
        c(k, 3) = a(i, 3)
        c(k, 4) = a(i, 9)
        nTotal = nTotal + a(i, 9)
        n = n + 1
        k = k + 1
      End If
    Next
    c(k, 1) = "SUM"
    c(k, 4) = nTotal
    k = k + 3
  Next
  
  With Sheets("REPORT")
    .Cells.Clear
    .Range("A1").Resize(UBound(c, 1), UBound(c, 2)).Value = c
    
    
    '******************** FORMAT CELLS ***************************
    .Columns("A:D").HorizontalAlignment = xlCenter
    .Columns("B:B").NumberFormat = "yyyy/mm/dd"
    .Columns("D:D").NumberFormat = "#,##0.00"
    .Range("A:D").Font.Name = "Times"
    .Range("A:D").Font.Size = 14
    .Columns("A:E").EntireColumn.AutoFit
    Set f = .Range("A:A").Find("ITEM", , xlValues, xlWhole)
    If Not f Is Nothing Then
      cell = f.Address
      Do
        f.Resize(1, 4).Font.Color = vbWhite
        f.Resize(1, 4).Interior.Color = wcolor
        lr = f.Cells(f.Rows.Count, 1).End(xlDown).Row - f.Row + 1
        With f.Resize(lr, 4).Borders
          .LineStyle = xlContinuous
          .Color = vbBlack
          .Weight = xlThin
        End With
        
        f.Offset(-1, 1).Font.Color = vbWhite
        f.Offset(-1, 1).Interior.Color = wcolor
        With f.Offset(-1, 1).Borders
          .LineStyle = xlContinuous
          .Color = vbBlack
          .Weight = xlThin
        End With
  
        Set f = .Range("A:A").FindNext(f)
      Loop While f.Address <> cell
    End If
    
    Set f = .Range("A:A").Find("SUM", , xlValues, xlWhole)
    If Not f Is Nothing Then
      cell = f.Address
      Do
        f.Interior.Color = wcolor2
        Set f = .Range("A:A").FindNext(f)
      Loop While f.Address <> cell
    End If
    '******************** END FORMAT CELLS ************************
  End With
End Sub

Regards
Dante Amor

 

[abdo meghari]

Hi Dante , I hope you're fine .
first I'm really sorry to delaying
second the code works perfectly as I did it .
finally thank you so much .

 

[DanteAmor]

Hello Abdo, I'm fine, thanks for asking. I hope you are also well..

As always, happy to help you. It's always nice to help when you make the effort to explain in detail what you need.

Regards
Dante Amor