populate amounts from lastrow for each separated range for each group

[abdo meghari]

Hello
I want macro ( don't solution by POWERQUERY) to show amount for each group.
each group contains amount in TOTAL column H for adjacent cell( SELLING NET in column F) .so should brings the GROUP NAME from GROUP/COMPANY: as header for each group in column C and the amount for each GROUP is existed in column H and sum whole amounts for all of groups as show in column C in out sheet.
the OUT sheet will be empty so should create report as I did it with formatting and borders.
at leas I have 500 groups and TOTAL rows could be 8000 rows .

AA
	A	B	C	D	E	F	G	H
1			GROUP/COMPANY: GOMMEST
2	ITEM	BRAND NO	DESCRIPTION	UNIT	QTY	SELLING PRICE	COSTING PRICE	TOTAL
3	1	GOMMEST	BLUE TR414 100 PCS	PIECE	25.00	0.45	0.33	3.00
4	2	GOMMEST	EUS-65 ROUND PATCH 65X65	PIECE	10.00	2.50	1.50	10.00
5	3	GOMMEST	P1108 TAIWAN	PIECE	11.00	5.50	3.50	22.00
6	4	GOMMEST	PTO-2301-R 0.6X100MM.	PIECE	88.00	1.50	1.25	22.00
7	5	GOMMEST	VMTC 7.50-16 V3-02-7	PIECE	1.00	60.00	45.00	15.00
8	6	GOMMEST	HEADER OF PRESSURE	PIECE	1.00	4.00	0.55	3.45
9	7	GOMMEST	LEAD 10GM WIDE	PIECE	3.00	0.75	0.25	1.50
10	8	GOMMEST	LEAD 10GM TIDE	PIECE	7.00	0.85	0.35	3.50
11	9	GOMMEST	LEAD 15GM WIDE	PIECE	4.00	0.65	0.44	0.84
12	10	GOMMEST	LEAD 15GM TIDE	PIECE	6.00	0.95	0.45	3.00
13	11	GOMMEST	LEAD 20GM WIDE	PIECE	7.00	0.70	0.46	1.68
14	12	GOMMEST	LEAD 20GM TIDE	PIECE	16.00	0.80	0.47	5.28
15	13	GOMMEST	BOAF0-50	PIECE	210.00	0.90	0.48	88.20
16	14	GOMMEST	XIA TW-9250 250ML	PIECE	1.00	0.95	0.49	0.46
17						SELLING NET		179.91
18
19
20
21			GROUP/COMPANY: TIRES
22	ITEM	BRAND NO	DESCRIPTION	UNIT	QTY	SELLING PRICE	COSTING PRICE	TOTAL
23	1	TIRES	BS 750R16 R230 JAP	PIECE	10.00	450.00	400.00	500.00
24	2	TIRES	BS 750R16 VSJ JAP	PIECE	8.00	750.00	700.00	400.00
25	3	TIRES	BS 1200R20 G580 JAP	PIECE	2.00	2,500.00	2,400.00	200.00
26	4	TIRES	BS 315/80R22.5 R184 JAP	PIECE	80.00	1,950.00	1,900.00	4,000.00
27	5	TIRES	BS 1400R20 VSJ JAP	PIECE	1.00	4,000.00	3,900.00	100.00
28	6	TIRES	BS 1200R24 G580 JAP	PIECE	2.00	2,800.00	2,700.00	200.00
29	7	TIRES	GC 1200R20 AZ026 CHI	PIECE	2.00	1,350.00	1,300.00	100.00
30	8	TIRES	GC 1200R20 QAZ183 CHI	PIECE	5.00	1,450.00	1,400.00	250.00
31						SELLING NET		5,750.00
32
33
34
35			GROUP/COMPANY: BATTERY
36	ITEM	BRAND NO	DESCRIPTION	UNIT	QTY	SELLING PRICE	COSTING PRICE	TOTAL
37	1	BATTERY	XPRO 70A L KOR	PIECE	1.00	350.00	300.00	50.00
38	2	BATTERY	XPRO 70A R KOR	PIECE	2.00	300.00	250.00	100.00
39	3	BATTERY	XPRO 90A R KOR	PIECE	2.00	425.00	400.00	50.00
40	4	BATTERY	HANKOOK 150A L KOR	PIECE	10.00	850.00	800.00	500.00
41	5	BATTERY	ASIMCO 150A L KOR	PIECE	1.00	750.00	700.00	50.00
42						SELLING NET		750.00
43
44						SELLING NET TOTAL		6,679.91
GROUP

Cell Formulas
Range	Formula
H37:H41,H23:H30,H3:H16	H3	=(F3-G3)*E3
H17	H17	=SUM(H3:H16)
H31	H31	=SUM(H23:H30)
H42	H42	=SUM(H37:H41)
H44	H44	=H42+H31+H17

result should be

AA
	A	B	C
1	ITEM	GROUP	SELLING NET
2	1	GOMMEST	179.91
3	2	TIRES	5,750.00
4	3	BATTERY	750.00
5	TOTAL		6,679.91
out

Cell Formulas
Range	Formula
C5	C5	=SUM(C2:C4)

thanks

 

[HongRu]

Try.

Sub Main()
    Dim sGROUP As Worksheet
    Set sGROUP = Worksheets("GROUP")
    
    Dim sOUT As Worksheet
    Set sOUT = Worksheets("OUT")
    
    sOUT.Range("A1") = "ITEM"
    sOUT.Range("B1") = "GROUP"
    sOUT.Range("C1") = "SELLING NET"
    
    Dim myCheck As Range
    Set myCheck = sGROUP.Range("C1")
    Do Until myCheck = ""
        i = i + 1
        With sOUT.Range("A1")
            .Offset(i) = i
            .Offset(i, 1) = Split(myCheck, ": ")(1)
            .Offset(i, 2) = myCheck.End(xlDown).Offset(1, 5)
        End With
        Set myCheck = myCheck.End(xlDown).End(xlDown)
    Loop
    
    i = i + 1
    sOUT.Range("A1").Offset(i) = "TOTAL"
    sOUT.Range("A1").Offset(i, 2) = myCheck.End(xlUp).Offset(3, 5)
    
    sbFormat sOUT
End Sub

Sub sbFormat(sOUT As Worksheet)
    With sOUT.Range("A1").CurrentRegion
        .Font.Size = 10
        .Borders.LineStyle = xlContinuous
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Resize(1).Font.Bold = True
        .Resize(, 1).Offset(0, 2).Style = "Comma"
    End With
    sOUT.Range("A" & Rows.Count).End(xlUp).Font.Bold = True
    
    sOUT.Columns("A:C").EntireColumn.AutoFit
End Sub

 

[Fuji]

Sub test()
    Dim i&, x, ws As Worksheet
    Set ws = Sheets("out")
    ws.[a1].CurrentRegion.Clear
    With Sheets("group")
        x = Application.VLookup("SELLING NET TOTAL", .Columns("f:h"), 3, False)
        With .Columns("a").SpecialCells(2, 1).Areas
            For i = 1 To .Count
                ws.Cells(i + 1, 1).Resize(, 3) = Array(i, .Item(i)(1)(1, 2), .Item(i)(.Item(i).Count + 1)(1, 8))
            Next
        End With
    End With
    With ws.[a1].CurrentRegion.Resize(, 3)
        Union(.Rows(1), .Columns("a:b")).HorizontalAlignment = xlCenter
        .Rows(1) = [{"ITEM","GROUP","SELLING NET"}]
        If Not IsError(x) Then
            .Cells(.Rows.Count + 1, 1).Resize(, 3) = Array("TOTAL", Empty, x)
            Union(.Rows(1), .Cells(.Rows.Count + 1, 1)).Font.Bold = True
        End If
        .Resize(.Rows.Count + IIf(Not IsError(x), 1, 0)).Borders.Weight = 2
        .EntireColumn.AutoFit
    End With
End Sub

 

[kvsrinivasamurthy]

Try.

Sub GetGroups()
Dim Ro1, Ro2, k
Dim LR&, T&
Sheets("GROUP").Activate
LR = Range("A" & Rows.Count).End(xlUp).Row + 1
k = "transpose(IF(Isnumber(Find(""GROUP"",GROUP!C1:C" & LR & ")),row(C1:C" & LR & "),false))"
Ro1 = Filter(Evaluate("transpose(IF(Isnumber(Find(""GROUP"",GROUP!C1:C" & LR & ")),row(C1:C" & LR & "),false))"), False, False)
Ro2 = Filter(Evaluate("transpose(IF(Isnumber(Find(""SELLING NET"",GROUP!F1:F" & LR & ")),row(F1:F" & LR & "),false))"), False, False)
ReDim B(0 To UBound(Ro1), 1 To 2)
For T = 0 To UBound(Ro1)
B(T, 1) = Replace(Range("C" & Ro1(T)).Value, "GROUP/COMPANY:", "")
B(T, 2) = Range("H" & Ro2(T))
Next T

Sheets("OUT").Delete
Sheets.Add.Name = "OUT"

With Sheets("OUT")
.Range("A1:B1") = Array("GROUP/COMPANY", "TOTAL")
.Range("A2").Resize(UBound(Ro1) + 1, 2) = B
.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
End With

End Sub

 

[abdo meghari]

HongRu & Fuji both codes are great !
@Fuji
How should show "#,##0.00" for amount in TOTAL row,please?
many thanks for your help.

 

[abdo meghari]

@kvsrinivasamurthy
thanks but ITEM column and TOTAL row are missed!

 

[kvsrinivasamurthy]

Try.

Sub GetGroups()
Dim Ro1, Ro2, k
Dim LR&, T&, X&
Dim TotAmt#
Application.DisplayAlerts = False
Sheets("GROUP").Activate
LR = Range("A" & Rows.Count).End(xlUp).Row + 1
k = "transpose(IF(Isnumber(Find(""GROUP"",GROUP!C1:C" & LR & ")),row(C1:C" & LR & "),false))"
Ro1 = Filter(Evaluate("transpose(IF(Isnumber(Find(""GROUP"",GROUP!C1:C" & LR & ")),C1:C" & LR & ",false))"), False, False)
Ro2 = Filter(Evaluate("transpose(IF(Isnumber(Find(""SELLING NET"",GROUP!F1:F" & LR & ")),H1:H" & LR & ",false))"), False, False)
ReDim B(0 To UBound(Ro1) + 1, 0 To 2)
For T = 0 To UBound(Ro1)
X = X + 1: B(T, 0) = X
B(T, 1) = Replace(Ro1(T), "GROUP/COMPANY:", "")
B(T, 2) = Ro2(T)
TotAmt = TotAmt + Ro2(T)
Next T

Sheets("OUT").Delete
Sheets.Add.Name = "OUT"

With Sheets("OUT")
.Range("A1:C1") = Array("ITEM", "GROUP/COMPANY", "SELLING NET")
.Range("A2").Resize(UBound(Ro1) + 1, 3) = B
.Range("A2").Resize(UBound(Ro1) + 1, 1).HorizontalAlignment = xlCenter
.Range("A1").Offset(UBound(Ro1) + 2, 1).Resize(1, 2) = Array("TOTAL", TotAmt)
.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
.Range("A1").CurrentRegion.Columns.AutoFit
End With
Application.DisplayAlerts = True
End Sub

 

[Fuji]

Insert one line

        End If
        .Resize(.Rows.Count + 1).Columns(3).NumberFormatLocal = "#,#.00"   '<--- this line
        .Resize(.Rows.Count + IIf(Not IsError(x), 1, 0)).Borders.Weight = 2

 

[abdo meghari]

@kvsrinivasamurthy


thank you so much.

 

[abdo meghari]

@Fuji

thank you so much.