Macro to compare old prices with new prices for stock and show(-/+)

[KalilMe]

Hello,
in QW sheet will be multiple columns contain prices and every time I will add new column contain new prices .
in STOCK sheet contains data in columns A:E
what I want create report in columns G:L with formatting and borders by brings the prices from last column in QW sheet and put in column J , as to column K=column I* column J
column L =column K- column E
in lastrow for column G when amount is minus in column L then populate LOSE word ,amount is plus in column L then populate PROFIT word.
if there is empty cell in last column in QW when brings price from previous column(not the first column) for instance if there is price in columnL,M,N and if the id doesn't existed price in column N then will brings from column M .
when create report will match BATCH column for two sheets , also if there is ID in STOCK sheet and it's not existed in QW sheet then will show as in STOCK sheet.

subtra.xlsm
	J	K	L	M
1	ITEM	BATCH	01/11/2024	02/11/2024
2	1	APP PP FRUIT	12.00	11.00
3	2	BAN FF FRUIT	9.00
4	3	CU CMC VEG	11.00	11.00
5	4	FRU BANN MU	22.00	23.00
6	5	PI PIA FRUIT	21.00	21.00
7	6	PO PTT VEG	12.00	11.00
8	7	TO TMA VEG	5.00	4.00
9	8	TE TEE FOOD	23.00	18.00
10	9	TRB POT BNG	22.00	24.00
QW

subtra.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	ITEM	BATCH	QTY	UNIT PRICE	TOTAL
2	1	TO TMA VEG	10.00	5.00	50.00
3	2	PO PTT VEG	20.00	10.00	200.00
4	3	BAN FF FRUIT	100.00	12.00	1,200.00
5	4	APP PP FRUIT	100.00	10.00	1,000.00
6	5	PI PIA FRUIT	12.00	22.00	264.00
7	6	TE TEE FOOD	100.00	23.00	2,300.00
8	7	CU CMC VEG	120.00	21.00	2,520.00
9	8	TRB POT BNG	100.00	22.00	2,200.00
10	9	FRU BANN MU	124.00	22.00	2,728.00
11
12
13
14
STOCK

result

subtra.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	ITEM	BATCH	QTY	UNIT PRICE	TOTAL		ITEM	BATCH	QTY	UNIT PRICE	TOTAL	D/P
2	1	TO TMA VEG	10.00	5.00	50.00		1	TO TMA VEG	10.00	4.00	40.00	-10.00
3	2	PO PTT VEG	20.00	10.00	200.00		2	PO PTT VEG	20.00	11.00	220.00	20.00
4	3	BAN FF FRUIT	100.00	12.00	1,200.00		3	BAN FF FRUIT	100.00	9.00	900.00	-300.00
5	4	APP PP FRUIT	100.00	10.00	1,000.00		4	APP PP FRUIT	100.00	11.00	1,100.00	100.00
6	5	PI PIA FRUIT	12.00	22.00	264.00		5	PI PIA FRUIT	12.00	21.00	252.00	-12.00
7	6	TE TEE FOOD	100.00	23.00	2,300.00		6	TE TEE FOOD	100.00	18.00	1,800.00	-500.00
8	7	CU CMC VEG	120.00	21.00	2,520.00		7	CU CMC VEG	120.00	11.00	1,320.00	-1,200.00
9	8	TRB POT BNG	100.00	22.00	2,200.00		8	TRB POT BNG	100.00	24.00	2,400.00	200.00
10	9	FRU BANN MU	124.00	22.00	2,728.00		9	FRU BANN MU	124.00	23.00	2,852.00	124.00
11							LOSE					-1,578.00
12
13
STOCK

Cell Formulas
Range	Formula
L2:L10	L2	=K2-E2
L11	L11	=SUM(L2:L10)

I need macro , I don't PQ or PT , formulas
thanks

 

[KalilMe]

Where is your desired result with the average unit cost?

I put in column K

 

[KalilMe]

I have modified code. Pl try.

thanks
may you see file in post#42 how show average price by brings from QW sheet and D for STOCK sheet ?
I put in column K how should be.

 

[Fuji]

Sub test()
    Dim s$(1), i&, x&, r As Range, c As Range, ws As Worksheet
    Application.ScreenUpdating = False
    Set ws = Sheets("stock")
    ws.Columns("g:m").Clear
    With Sheets("qw")
        With .Range("j1", .Cells.SpecialCells(11))
            Set r = .Columns(.Columns.Count + 1)
            r.Cells(1) = "UP"
            r.Cells(2).FormulaArray = Replace("=index(#,max(if(#<>"""",column(#)-9)))", "#", "rc10:rc[-1]")
            r.Cells(2).Resize(r.Rows.Count - 1).FillDown
        End With
    End With
    s(1) = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties='Excel 12.0;HDR=Yes';"
    s(0) = "Select A.`ITEM`, A.`BATCH`, A.`QTY`, IIf(IsNull(B.`UP`), A.`UNIT PRICE`, B.`UP`) As `UNIT PRICE`, " & _
        "IIf(IsNull(B.`UP`),Null,(B.`UP` + A.`UNIT PRICE`) /2) As `AVG U/P`,IIf(IsNull(B.`UP`), A.`TOTAL`, " & _
        "A.`QTY` * B.`UP`) As `TOTAL`, A.`QTY` * B.`UP` - A.`TOTAL` As `D/P` " & _
        "From `STOCK$` As A Left Join `QW$` As B On A.`BATCH` = B.`BATCH`;"
    With CreateObject("ADODB.Recordset")
        .Open s(0), s(1), 3, 3, 1
        For i = 0 To .Fields.Count - 1
            ws.Cells(1, i + 7) = .Fields(i).Name
        Next
        ws.[g2].CopyFromRecordset .DataSource
    End With
    r.Clear
    With ws.[g1].CurrentRegion
        .HorizontalAlignment = xlCenter
        .Columns("d:l").NumberFormat = "#,0.00"
        Union(.Rows(1), .Rows(.Rows.Count + 1)).Font.Bold = True
        Set c = .Cells(.Rows.Count + 1, .Columns.Count)
        c.Formula = "=sum(r2c:r[-1]c)"
        .Cells(.Rows.Count + 1, 1) = IIf(c > 0, "GAIN", "LOOSE")
        .EntireColumn.AutoFit
        .Resize(.Rows.Count + 1).Borders.Weight = 2
    End With
    Application.ScreenUpdating = True
End Sub

sub (1).xlsm
	G	H	I	J	K	L	M
1	ITEM	BATCH	QTY	UNIT PRICE	AVG U/P	TOTAL	D/P
2	1	TO TMA VEG	10	4.00	4.50	40.00	-10.00
3	2	PO PTT VEG	20	11.00	10.50	220.00	20.00
4	3	BAN FF FRUIT	100	9.00	10.50	900.00	-300.00
5	4	APP PP FRUIT	100	11.00	10.50	1,100.00	100.00
6	5	PI PIA FRUIT	12	21.00	21.50	252.00	-12.00
7	6	TE TEE FOOD	100	18.00	20.50	1,800.00	-500.00
8	7	CU CMC VEG	120	11.00	16.00	1,320.00	-1,200.00
9	8	TRB POT BNG	100	24.00	23.00	2,400.00	200.00
10	9	FRU BANN MU	124	23.00	22.50	2,852.00	124.00
11	10	FRU TT MU	124	18.00		2,728.00
12	LOOSE						-1,578.00
STOCK

Cell Formulas
Range	Formula
M12	M12	=SUM(M$2:M11)

 

[KalilMe]

Nice work Fuji !
many thanks for your time & help.

 

[Peter_SSs]

You have marked post #13 as the correct solution. Is that still the case?

You did not answer that question but I note that the Mark as solution has been removed. So, if we are reverting to not averaging but using the value from 'QW' if it exists or else the value from 'STOCK' then

Sub PROFITorLOSE_v4()
  Dim d As Object
  Dim a As Variant
  Dim i As Long, j As Long, cols As Long
  Dim OT As Double, GT As Double
 
  Set d = CreateObject("Scripting.Dictionary")
  With Sheets("QW")
    a = .Range("K1").Resize(.Cells(Rows.Count, "K").End(xlUp).Row, .Cells(1, Columns.Count).End(xlToLeft).Column - 10)
  End With
  cols = UBound(a, 2)
  For i = 2 To UBound(a)
    For j = cols To 2 Step -1
      If Len(a(i, j)) > 0 Then
        d(a(i, 1)) = a(i, j)
        Exit For
      End If
    Next j
  Next i
  With Sheets("STOCK")
    a = .Range("A1:F1").Resize(.Range("A" & Rows.Count).End(xlUp).Row + 1).Value
    a(1, 6) = "D/P"
    For i = 2 To UBound(a) - 1
      a(i, 4) = IIf(d.exists(a(i, 2)), d(a(i, 2)), a(i, 4))
      OT = a(i, 5)
      a(i, 5) = a(i, 3) * a(i, 4)
      a(i, 6) = a(i, 5) - OT
      GT = GT + a(i, 6)
    Next i
    a(UBound(a), 6) = GT
    a(UBound(a), 1) = IIf(GT >= 0, "PROFIT", "LOSE")
    .Columns("G:L").Delete
    With .Range("G1").Resize(UBound(a), 6)
      .Value = a
      .Columns(3).Resize(, 4).NumberFormat = "#,##0.00"
      Union(.Rows(1), .Cells(UBound(a), 1)).Font.Bold = True
      .Columns.AutoFit
      .Borders.LineStyle = xlContinuous
    End With
  End With
End Sub

KalilMe_sub.xlsm
	J	K	L	M
1	ITEM	BATCH	1/11/2024	2/11/2024
2	1	APP PP FRUIT	12.00	11.00
3	2	BAN FF FRUIT	9.00
4	3	CU CMC VEG	11.00	11.00
5	4	FRU BANN MU	22.00	23.00
6	5	PI PIA FRUIT	21.00	21.00
7	6	PO PTT VEG	12.00	11.00
8	7	TO TMA VEG	5.00	4.00
9	8	TE TEE FOOD	23.00	18.00
10	9	TRB POT BNG	22.00	24.00
QW

In the sheet below, note that I have altered E11 so that it is the result of multiplying C11 by D11.

KalilMe_sub.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L
1	ITEM	BATCH	QTY	UNIT PRICE	TOTAL		ITEM	BATCH	QTY	UNIT PRICE	TOTAL	D/P
2	1	TO TMA VEG	10.00	5.00	50.00		1	TO TMA VEG	10.00	4.00	40.00	-10.00
3	2	PO PTT VEG	20.00	10.00	200.00		2	PO PTT VEG	20.00	11.00	220.00	20.00
4	3	BAN FF FRUIT	100.00	12.00	1,200.00		3	BAN FF FRUIT	100.00	9.00	900.00	-300.00
5	4	APP PP FRUIT	100.00	10.00	1,000.00		4	APP PP FRUIT	100.00	11.00	1,100.00	100.00
6	5	PI PIA FRUIT	12.00	22.00	264.00		5	PI PIA FRUIT	12.00	21.00	252.00	-12.00
7	6	TE TEE FOOD	100.00	23.00	2,300.00		6	TE TEE FOOD	100.00	18.00	1,800.00	-500.00
8	7	CU CMC VEG	120.00	21.00	2,520.00		7	CU CMC VEG	120.00	11.00	1,320.00	-1,200.00
9	8	TRB POT BNG	100.00	22.00	2,200.00		8	TRB POT BNG	100.00	24.00	2,400.00	200.00
10	9	FRU BANN MU	124.00	22.00	2,728.00		9	FRU BANN MU	124.00	23.00	2,852.00	124.00
11	10	FRU TT MU	124.00	18.00	2,232.00		10	FRU TT MU	124.00	18.00	2,232.00	0.00
12							LOSE					-1,578.00
13
STOCK

 

[KalilMe]

You did not answer that question

actually I did it in post#49

so your suggestion still solve my requirements.

but I note that the Mark as solution has been removed

yes this is before inform me my bad about calculation . after that I remarked solved.

So, if we are reverting to not averaging but using the value from 'QW' if it exists or else the value from 'STOCK' then

this is is really good , but currently I would averages prices.
so I got a big help with multiple solutions .

 

[Peter_SSs]

actually I did it in post#49

It wasn't clear to me whether post #13 was the accepted solution or something else.

So, as I understand it, as far as my suggestions go ..

• Post #13 is a solution if averaging (where available) is required
• Post #55 is a solution if averaging is not required.

Are those two things correct?

 

[KalilMe]

It wasn't clear to me whether post #13 was the accepted solution or something else.

ok .

Are those two things correct?

yes , but are really both useful.

 

[Peter_SSs]

• Post #13 is a solution if averaging (where available) is required
• Post #55 is a solution if averaging is not required.

Are those two things correct?

yes

Great. Thanks for the confirmation.