Extract Brands contains different prices with comparison original prices

A

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
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
Try.
VBA Code: 
Sub TransferData()
Dim A
Dim Lr&, Lr2&, Lr3&
Lr = Range("A" & Rows.Count).End(xlUp).Row
'ActiveSheet.AutoFilter
Lr = Range("A" & Rows.Count).End(xlUp).Row
Range("$I$1").CurrentRegion.Offset(1, 0).Clear
With Range("$A$1").CurrentRegion
.AutoFilter
.AutoFilter Field:=1, Criteria1:="<>TOTAL"
    With .Offset(1, 0)
    .Columns(1).Copy Range("I2")
    .Columns(4).Copy Range("J2")
    .Columns(5).Copy Range("K2")
    .Columns(6).Copy Range("L2")
    End With
.AutoFilter
End With
Lr2 = Range("I" & Rows.Count).End(xlUp).Row
Lr3 = Range("P" & Rows.Count).End(xlUp).Row
Range("M2:M" & Lr2).Formula = "=L2-Index($R$2:$R$" & Lr3 & ",match($J2,$Q$2:$Q$" & Lr3 & ",0))"
Range("N2:N" & Lr2).Formula = "=K2*M2"
Range("M2:N" & Lr3).NumberFormat = "0.00;[Red]-0.00"
End Sub
 
Last edited:
Upvote 0
thanks
this is what I got
MG.xlsm
IJKLMN
1DATEBRANDQTYPRICEDIFFERNCE(+/-)BALANCE
201/01/2024BS 750R16 R230 JAP22.00460.0010.00220
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
602/01/2024BS 750R16 R230 JAP10.00440.00-10.00-100
702/01/2024BS 205/70R15C R62310.00500.000.000
803/01/2024BS 1200R20 G580 JAP10.002,850.0050.00500
PURCHASE
Cell Formulas
RangeFormula
M2:M8M2=L2-INDEX($R$2:$R$8,MATCH($J2,$Q$2:$Q$8,0))
N2:N8N2=K2*M2


there are missed borders around cells and where is sum row ?
also where is highlighted font minus value by red?
also the code should implement for two sheets as I said
create report in range I:N for two sheets PURCHASE and SALES
Click to expand...
 
Upvote 0
Try.
VBA Code: 
Sub TransferData()
Dim A
Dim Lr&, Lr2&, Lr3&
Lr = Range("A" & Rows.Count).End(xlUp).Row
Lr = Range("A" & Rows.Count).End(xlUp).Row
Range("$I$1").CurrentRegion.Offset(1, 0).Clear
With Range("$A$1").CurrentRegion
.AutoFilter
.AutoFilter Field:=1, Criteria1:="<>TOTAL"
    With .Offset(1, 0)
    .Columns(1).Copy Range("I2")
    .Columns(4).Copy Range("J2")
    .Columns(5).Copy Range("K2")
    .Columns(6).Copy Range("L2")
    End With
.AutoFilter
End With
Lr2 = Range("I" & Rows.Count).End(xlUp).Row
Lr3 = Range("P" & Rows.Count).End(xlUp).Row
Range("M2:M" & Lr2).Formula = "=L2-Index($R$2:$R$" & Lr3 & ",match($J2,$Q$2:$Q$" & Lr3 & ",0))"
Range("N2:N" & Lr2).Formula = "=K2*M2"
Range("M2:N" & Lr2).NumberFormat = "0.00;[Red]-0.00"
Range("I" & Lr2 + 1) = "SUM"
Range("M" & Lr2 + 1 & ":N" & Lr2 + 1).Formula = "=Sum(M2:M" & Lr2 & ")"
Range("$I$1").CurrentRegion.Borders.LineStyle = xlContinuous

    Range("J12").Select
    ActiveWorkbook.Save
    Range("N9").Select
End Sub
 
Upvote 0
thanks

how about implement two sheets ?
I try to put in array but doesn't work !

VBA Code: 
Sub TransferData()
Dim A
Dim Lr&, Lr2&, Lr3&
Dim ws As Variant
ws = Array("PURCHASE", "SALES")
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
.AutoFilter
.AutoFilter Field:=1, Criteria1:="<>TOTAL"
    With .Offset(1, 0)
    .Columns(1).Copy Range("I2")
    .Columns(4).Copy Range("J2")
    .Columns(5).Copy Range("K2")
    .Columns(6).Copy Range("L2")
    End With
.AutoFilter
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

    Range("J12").Select
    ActiveWorkbook.Save
    Range("N9").Select
    End Sub
 
Upvote 0
I have the same data in the same range for both sheets
it 's the same structure as in OP.
so the result will be in each sheet alone instead of active sheet as the code does it .
 
Upvote 0
Try.
VBA Code: 
Sub TransferData()
Dim A, ary
Dim Lr&, Lr2&, Lr3&
Dim ws As Variant
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
.AutoFilter
.AutoFilter Field:=1, Criteria1:="<>TOTAL"
    With .Offset(1, 0)
    .Columns(1).Copy Range("I2")
    .Columns(4).Copy Range("J2")
    .Columns(5).Copy Range("K2")
    .Columns(6).Copy Range("L2")
    End With
.AutoFilter
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
End Sub
 
Upvote 0
become in PURCHASE sheet
MG.xlsm
IJKLMN
1DATEBRANDQTYPRICE#N/A#N/A
2SUM#N/A#N/A
PURCHASE
Cell Formulas
RangeFormula
M1M1=L2-INDEX($R$2:$R$8,MATCH($J2,$Q$2:$Q$8,0))
N1N1=K2*M2
M2:N2M2=SUM(M1:M2)


it's ok for SALES sheet when active
MG.xlsm
IJKLMN
1DATEBRANDQTYPRICE0.000.00
201/01/2024BS 750R16 R230 JAP2.00430.000.000.00
301/01/2024BS 700R16 R2302.00410.00-10.00-20.00
402/01/2024BS 1200R20 G580 JAP20.002,820.00120.002400.00
502/01/2024BS 205/70R15C R6231.00490.00-10.00-10.00
603/01/2024BS 1200R20 G580 JAP2.002,780.0080.00160.00
7SUM180.002530.00
SALES
Cell Formulas
RangeFormula
M1M1=L2-INDEX($R$2:$R$8,MATCH($J2,$Q$2:$Q$8,0))
N1N1=K2*M2
M2:M6M2=L2-INDEX($R$2:$R$8,MATCH($J2,$Q$2:$Q$8,0))
N2:N6N2=K2*M2
M7:N7M7=SUM(M2:M6)
 
Upvote 0
Code corrected.
VBA Code: 
Sub TransferData()
Dim A, ary
Dim Lr&, Lr2&, Lr3&
Dim ws As Variant
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
.AutoFilter
.AutoFilter Field:=1, Criteria1:="<>TOTAL"
    With .Offset(1, 0)
    .Columns(1).Copy ws.Range("I2")
    .Columns(4).Copy ws.Range("J2")
    .Columns(5).Copy ws.Range("K2")
    .Columns(6).Copy ws.Range("L2")
    End With
.AutoFilter
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
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
compare brands between two sheets and show minus and positive values based on date (today)
Replies
6
Views
241
abdo meghari
A
A
  • Solved
Track movement stock in listbox on userform by copy amounts from previous row to next row
Replies
8
Views
105
abdo meghari
A
A
  • Solved
add / subtract new price in cell to multiple cells in column based on two cells values
Replies
7
Views
169
abdo meghari
A
A
  • Solved
Merging duplicates items after words contains colon based on different price for the same ID
2 3 4
Replies
39
Views
667
Peter_SSs
Peter_SSs
A
  • Question Question
Split sheets into multiple sheets based on how many rows in cell value
Replies
3
Views
162
abdo meghari
A

Forum statistics

Threads
1,224,812
Messages
6,181,098
Members
453,021
Latest member
Justyna P

Share this page

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