Extract Brands contains different prices with comparison original prices

abdo meghari

Well-known Member
Joined
Aug 3, 2021
Messages
651
Office Version
  1. 2019
Hi,
I search for macro to create report in range I:N for two sheets PURCHASE and SALES
I will take PURCHASE sheet as example:
MG.xlsm
ABCDEFGHIJKLMNOPQR
1DATECUSTOMERINVOICE NOBRANDQTYPRICETOTALDATEBRANDQTYPRICEDIFFERNCE(+/-)BALANCEITEMBRANDPRICE
201/01/2024Abdom1BSJ1000BS 750R16 R230 JAP22.00460.0010,120.001BS 700R16 R230400.00
301/01/2024Abdom1BSJ1000BS 700R16 R23010.00410.004,100.002BS 750R16 R230 JAP450.00
4TOTAL14,220.003BS 205/70R15C R623500.00
501/01/2024Abdom1BSJ1001BS 700R16 R23010.00390.003,900.004BS 1200R20 G580 JAP2,800.00
6TOTAL3,900.005BS 1200R20 G580 THI2,500.00
702/01/2024Abbdo mBSJ1002BS 1200R20 G580 JAP20.002,800.0056,000.006BS 1200R20 R187 THI3,000.00
802/01/2024Abbdo mBSJ1002BS 750R16 R230 JAP10.00440.004,400.007DT 1200R20 050A THI3,200.00
902/01/2024Abbdo mBSJ1002BS 205/70R15C R62310.00500.005,000.00
10TOTAL65,400.00
PURCHASE
Cell Formulas
RangeFormula
G7:G9,G5,G2:G3G2=E2*F2
G4G4=SUM(G2:G3)
G6G6=SUM(G5)
G10G10=SUM(G7:G9)



what I want extract columns(DATE,,BRAND,QTY,PRICE) from columns A,D,E,F to columns I:L after that the result in column M will subtract prices column L from column R and column N = column M * column K and insert SUM row to sum column M,N and should highlight font minus value for columns M,N .so the result will be like this


MG.xlsm
ABCDEFGHIJKLMNOPQR
1DATECUSTOMERINVOICE NOBRANDQTYPRICETOTALDATEBRANDQTYPRICEDIFFERNCE(+/-)BALANCEITEMBRANDPRICE
201/01/2024Abdom1BSJ1000BS 750R16 R230 JAP22.00460.0010,120.0001/01/2024BS 750R16 R230 JAP22460.0010.00220.001BS 700R16 R230400.00
301/01/2024Abdom1BSJ1000BS 700R16 R23010.00410.004,100.0001/01/2024BS 700R16 R23010410.0010.00100.002BS 750R16 R230 JAP450.00
4TOTAL14,220.0001/01/2024BS 700R16 R23010390.00-10.00-100.003BS 205/70R15C R623500.00
501/01/2024Abdom1BSJ1001BS 700R16 R23010.00390.003,900.0002/01/2024BS 1200R20 G580 JAP202,800.000.000.004BS 1200R20 G580 JAP2,800.00
6TOTAL3,900.0002/01/2024BS 750R16 R230 JAP10440.00-10.00-100.005BS 1200R20 G580 THI2,500.00
702/01/2024Abbdo mBSJ1002BS 1200R20 G580 JAP20.002,800.0056,000.0002/01/2024BS 205/70R15C R62310500.000.000.006BS 1200R20 R187 THI3,000.00
802/01/2024Abbdo mBSJ1002BS 750R16 R230 JAP10.00440.004,400.0003/01/2024BS 1200R20 G580 JAP102,850.0050.00500.007DT 1200R20 050A THI3,200.00
902/01/2024Abbdo mBSJ1002BS 205/70R15C R62310.00500.005,000.00SUM50.00620.00
10TOTAL65,400.00
1103/01/2024Abbdo mBSJ1003BS 1200R20 G580 JAP10.002,850.0028,500.00
12TOTAL28,500.00
PURCHASE
Cell Formulas
RangeFormula
M2M2=L2-R3
N2:N8N2=M2*K2
M3M3=L3-R2
M4M4=L4-R2
M5M5=L5-R5
M6:M8M6=L6-R3
M9:N9M9=SUM(M2:M8)
G11,G7:G9,G5,G2:G3G2=E2*F2
G4G4=SUM(G2:G3)
G6,G12G6=SUM(G5)
G10G10=SUM(G7:G9)


the result for SALES sheet will be the same thing for the same structure .
the data in range A:G could be 9000 rows for both sheets
should delete data in range I: N from row2 before create report.
please don't give me solution by Power Query because doesn't work for me for many times .
thanks
 
there is problem in the header
may you see in M1,N1?
MG.xlsm
IJKLMN
1DATEBRANDQTYPRICE10.00220.00
201/01/2024BS 750R16 R230 JAP22.00460.0010.00220.00
301/01/2024BS 700R16 R23010.00410.0010.00100.00
401/01/2024BS 700R16 R23010.00390.00-10.00-100.00
502/01/2024BS 1200R20 G580 JAP20.002,800.000.000.00
602/01/2024BS 750R16 R230 JAP10.00440.00-10.00-100.00
702/01/2024BS 205/70R15C R62310.00500.000.000.00
803/01/2024BS 1200R20 G580 JAP10.002,850.0050.00500.00
9SUM50.00620.00
PURCHASE
Cell Formulas
RangeFormula
M1M1=L2-INDEX($R$2:$R$8,MATCH($J2,$Q$2:$Q$8,0))
N1N1=K2*M2
M2:M8M2=L2-INDEX($R$2:$R$8,MATCH($J2,$Q$2:$Q$8,0))
N2:N8N2=K2*M2
M9:N9M9=SUM(M2:M8)
 
Upvote 0

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
ok it's perfect !
I'm not sure if you read this
the data in range A:G could be 9000 rows for both sheets
because the code will be too slow!
is there any chance to make fast with big data please?
 
Upvote 0
Try.
VBA Code:
Sub TransferData()
Dim A, ary
Dim Lr&, Lr2&, Lr3&
Dim ws As Variant
Application.ScreenUpdating = False
ary = Array("PURCHASE", "SALES")
For T = 0 To UBound(ary)
Set ws = Sheets(ary(T))
Lr = ws.Range("A" & Rows.Count).End(xlUp).Row
Lr = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("$I$1").CurrentRegion.Offset(1, 0).Clear
With ws.Range("$A$1").CurrentRegion
.Columns(2).Hidden = True: .Columns(3).Hidden = True
.AutoFilter
.AutoFilter Field:=1, Criteria1:="<>TOTAL"
.CurrentRegion.Copy ws.Range("I2")
.AutoFilter
.Columns(2).Hidden = False: .Columns(3).Hidden = False
End With
Lr2 = ws.Range("I" & Rows.Count).End(xlUp).Row
Lr3 = ws.Range("P" & Rows.Count).End(xlUp).Row
ws.Range("M2:M" & Lr2).Formula = "=L2-Index($R$2:$R$" & Lr3 & ",match($J2,$Q$2:$Q$" & Lr3 & ",0))"
ws.Range("N2:N" & Lr2).Formula = "=K2*M2"
ws.Range("M2:N" & Lr2).NumberFormat = "0.00;[Red]-0.00"
ws.Range("I" & Lr2 + 1) = "SUM"
ws.Range("M" & Lr2 + 1 & ":N" & Lr2 + 1).Formula = "=Sum(M2:M" & Lr2 & ")"
ws.Range("$I$1").CurrentRegion.Borders.LineStyle = xlContinuous
Next T

    Range("J12").Select
    ActiveWorkbook.Save
    Range("N9").Select
Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Try this code. Not previous one.
VBA Code:
Sub TransferData()
Dim A, ary
Dim Lr&, Lr2&, Lr3&
Dim ws As Variant
Application.ScreenUpdating = False
ary = Array("PURCHASE", "SALES")
For T = 0 To UBound(ary)
Set ws = Sheets(ary(T))
Lr = ws.Range("A" & Rows.Count).End(xlUp).Row
Lr = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("$I$1").CurrentRegion.Offset(1, 0).Clear
With ws.Range("$A$1").CurrentRegion
.Columns(2).Hidden = True: .Columns(3).Hidden = True
.AutoFilter
.AutoFilter Field:=1, Criteria1:="<>TOTAL"
.CurrentRegion.Offset(1, 0).Copy ws.Range("I2")
.AutoFilter
.Columns(2).Hidden = False: .Columns(3).Hidden = False
End With
Lr2 = ws.Range("I" & Rows.Count).End(xlUp).Row
Lr3 = ws.Range("P" & Rows.Count).End(xlUp).Row
ws.Range("M2:M" & Lr2).Formula = "=L2-Index($R$2:$R$" & Lr3 & ",match($J2,$Q$2:$Q$" & Lr3 & ",0))"
ws.Range("N2:N" & Lr2).Formula = "=K2*M2"
ws.Range("M2:N" & Lr2).NumberFormat = "0.00;[Red]-0.00"
ws.Range("I" & Lr2 + 1) = "SUM"
ws.Range("M" & Lr2 + 1 & ":N" & Lr2 + 1).Formula = "=Sum(M2:M" & Lr2 & ")"
ws.Range("$I$1").CurrentRegion.Borders.LineStyle = xlContinuous
Next T

    Range("J12").Select
    ActiveWorkbook.Save
    Range("N9").Select
Application.ScreenUpdating = True
End Sub
 
Upvote 0
TRy.
VBA Code:
Sub TransferData()
Dim A, ary
Dim Lr&, Lr2&, Lr3&
Dim ws As Variant
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ary = Array("PURCHASE", "SALES")
For T = 0 To UBound(ary)
Set ws = Sheets(ary(T))
Lr = ws.Range("A" & Rows.Count).End(xlUp).Row
Lr = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("$I$1").CurrentRegion.Offset(1, 0).Clear
With ws.Range("$A$1").CurrentRegion
.Columns(2).Hidden = True: .Columns(3).Hidden = True
.AutoFilter
.AutoFilter Field:=1, Criteria1:="<>TOTAL"
.CurrentRegion.Offset(1, 0).Copy ws.Range("I2")
.AutoFilter
.Columns(2).Hidden = False: .Columns(3).Hidden = False
End With
Lr2 = ws.Range("I" & Rows.Count).End(xlUp).Row
Lr3 = ws.Range("P" & Rows.Count).End(xlUp).Row
ws.Range("M2:M" & Lr2).Formula = "=L2-Index($R$2:$R$" & Lr3 & ",match($J2,$Q$2:$Q$" & Lr3 & ",0))"
ws.Range("N2:N" & Lr2).Formula = "=K2*M2"
ws.Range("M2:N" & Lr2).NumberFormat = "0.00;[Red]-0.00"
ws.Range("I" & Lr2 + 1) = "SUM"
ws.Range("M" & Lr2 + 1 & ":N" & Lr2 + 1).Formula = "=Sum(M2:M" & Lr2 & ")"
ws.Range("$I$1").CurrentRegion.Borders.LineStyle = xlContinuous
Next T

    Range("J12").Select
    ActiveWorkbook.Save
    Range("N9").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,814
Messages
6,181,125
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top