Merge price as average price for data for two sheets.

abdo meghari

Well-known Member
Joined
Aug 3, 2021
Messages
682
Office Version
  1. 2019
Hi,
I would macro to merge price in columns D, H as average price for each brand in columns B,F for SV,STOCK sheets.
I don't need power query at all .


AFTER (2).xlsm
ABCDEFGHI
1ITEMDATECUSTOMERSINV.NOCASEBRANDQTYPRICEBALANCE
2115/06/2023CCF-1000BSTR_23448OUTSANDINGBS 750R16 R230 JAP3.00500.001,500.00
3215/06/2023CCF-1000BSTR_23448OUTSANDINGBS 700R16 R230 JAP2.00400.00800.00
4SUM2,300.00
5115/09/2023CCF-1000BSTR_23449OUTSANDINGGO 1200R20 AZ0026 CHI1.00920.00920.00
6215/09/2023CCF-1000BSTR_23449OUTSANDINGGO 1200R20 AZ0083 CHI1.001,000.001,000.00
7SUM1,920.00
8115/09/2023CCF-1000BSTR_23450PAIDBS 1200R20 G580 JAP9.001,800.0016,200.00
9215/09/2023CCF-1000BSTR_23450PAIDBS 1200R20 G580 THI9.001,800.0016,200.00
10315/09/2023CCF-1000BSTR_23450PAIDBS 1200R20 R187 THI10.001,800.0018,000.00
11SUM50,400.00
12116/09/2023CCF-1001BSTR_23452PAIDBS 1200R20 G580 JAP4.002,000.007,200.00
13SUM7,200.00
14117/09/2023CCF-1001BSTR_23453OUTSANDINGBS 1200R20 G580 JAP3.001,990.005,970.00
15217/09/2023CCF-1001BSTR_23453OUTSANDINGBS 750R16 R230 JAP2.00490.00980.00
16317/09/2023CCF-1001BSTR_23453OUTSANDINGBS 700R16 R230 JAP2.00440.00880.00
17417/09/2023CCF-1001BSTR_23453OUTSANDINGBS 1200R20 R187 THI3.001,770.005,310.00
18SUM13,140.00
19116/09/2023CCF-1001BSTR_23454PAIDBS 205/70R15C R623 JAP4.00520.002,080.00
20SUM2,080.00
SV





AFTER (2).xlsm
ABCDE
1ITEMBRANDQTYUNIT PRICEBALANCE
21GO 1200R20 AZ0026 CHI109809,800.00
32GO 1200R20 AZ0083 CHI2001010202,000.00
43BS 1200R20 G580 JAP10190019,000.00
54BS 1200R20 G580 THI20180036,000.00
65BS 1200R20 R187 THI10179017,900.00
76BS 1400R20 VSJ JAP10320032,000.00
87BS 1200R24 G580 JAP10220022,000.00
98BS 700R16 R230 JAP20043086,000.00
109BS 750R16 R230 JAP10049049,000.00
STOCK
Cell Formulas
RangeFormula
E2:E10E2=C2*D2



the result should be in REPORT sheet


AFTER (2).xlsm
ABC
1ITEMBRANDPRICE AVERAGE
21BS 700R16 R230 JAP423.33
32BS 750R16 R230 JAP493.33
43GO 1200R20 AZ0026 CHI920.00
54GO 1200R20 AZ0083 CHI1,000.00
65BS 1200R20 G580 JAP1,922.50
76BS 1200R20 G580 THI1,800.00
87BS 1200R20 R187 THI1,786.67
98BS 1200R24 G580 JAP2,200.00
109BS 1400R20 VSJ JAP3,200.00
1110BS 205/70R15C R623 JAP520.00
REPORT



so every new brand in two sheets will be show , the data in both sheets could be 10000 rows
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
I guess your data in REPORT sheet are not correct.
Your C2 in REPORT is 423.33.
I guess your formula is 423.33 = AVERAGE(400, 440, 430) .
But I suppose the correct formula should be (800 ( I3 in SV ) + 880 ( I16 in SV ) + 86000 ( E9 in STOCK) ) / ( 2 ( G3 in SV )+ 2 ( G16 in SV )+ 200 ( C9 in STOCK)) = 429.80 .

And your describe below might have something strange.
I would macro to merge price in columns D, H as average price for each brand in columns B,F for SV,STOCK sheets.
 
Upvote 0
Try.
Note: my average way is different from yours.
VBA Code:
Sub Price_Average()
    Application.ScreenUpdating = False
    Dim SV As Worksheet
    Set SV = Worksheets("SV")
    Dim Rng1 As Range
    Set Rng1 = SV.Range("A1").CurrentRegion
    Rows1 = Rng1.Rows.Count
    Set Rng1 = Rng1.Offset(0, 5).Resize(Rows1, 4)
    
    Dim STOCK As Worksheet
    Set STOCK = Worksheets("STOCK")
    Dim Rng2 As Range
    Set Rng2 = STOCK.Range("A1").CurrentRegion
    Rows2 = Rng2.Rows.Count - 1
    Set Rng2 = Rng2.Offset(1, 1).Resize(Rows2, 4)
    
    Dim temp As Worksheet
    Set temp = Worksheets.Add
    temp.Range("A1").Resize(Rows1, 4) = Rng1.Value
    temp.Range("A1").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    temp.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(Rows2, 4) = Rng2.Value
    
    Dim Table As Range
    Set Table = temp.Range("A1").CurrentRegion.Offset(1)
    Rows_Table = Table.Rows.Count - 1
    Set Table = Table.Resize(Rows_Table)
    
    Dim Brand As Range
    Set Brand = Table.Columns("A")
    Brand_unique = WorksheetFunction.Unique(Brand)
    Brand_unique_count = UBound(Brand_unique)
    
    Dim Qty As Range
    Set Qty = Table.Columns("B")
    
    Dim Balance As Range
    Set Balance = Table.Columns("D")
    
    'Brand
    temp.Range("G1").Resize(Brand_unique_count) = Brand_unique
    Dim Brand_G1 As Range
    Set Brand_G1 = temp.Range("G1").CurrentRegion
    
    'Item No.
    temp.Range("F1").Resize(Brand_unique_count) = WorksheetFunction.Sequence(Brand_unique_count)
    'PRICE AVERAGE
    temp.Range("H1").Formula2 = "=LET(x_1," & Brand.Address & _
                                   ", x_2," & Qty.Address & _
                                   ", x_3," & Balance.Address & _
                                   ", x_4," & Brand_G1.Address & _
                                   ", SCAN("""", x_4, LAMBDA(acc,x, SUM((x_1 = x) * x_3) / SUM((x_1 = x) * x_2))))"
    Dim Result As Range
    Set Result = temp.Range("H1").CurrentRegion

    Dim REPORT As Worksheet
    Set REPORT = Worksheets("REPORT")
    Dim Rng3 As Range
    Set Rng3 = REPORT.Range("A1")
    Rng3.CurrentRegion.ClearContents
    Rng3.Range("A1") = "Item"
    Rng3.Range("B1") = "Brand"
    Rng3.Range("C1") = "PRICE AVERAGE"
    Result.Copy
    Rng3.Offset(1).PasteSpecial xlPasteValues
    REPORT.Select
    Rng3.Activate
    
    Application.DisplayAlerts = False
    temp.Delete
    Application.DisplayAlerts = True
End Sub
 
Upvote 0
I guess your formula is 423.33 = AVERAGE(400, 440, 430) .
yes should be.
But I suppose the correct formula should be (800 ( I3 in SV ) + 880 ( I16 in SV ) + 86000 ( E9 in STOCK) ) / ( 2 ( G3 in SV )+ 2 ( G16 in SV )+ 200 ( C9 in STOCK)) = 429.80 .
no no !
I'm not talking about for column E
the PRICE column is existed in H,D columns for both sheets so the average will depends on column H,D as I mentioned.
I would macro to merge price in columns D, H as average price for each brand in columns B,F for SV,STOCK sheets.
by the way I tested your code and gives error unable to get the unique property of worksheetfunction
class
VBA Code:
  Brand_unique = WorksheetFunction.Unique(Brand)
my goal when there are brands cost price in stock and brands cost price for sv then will show me average price to compare with sale price for each brand to extract loss report
 
Last edited:
Upvote 0
Try again.
Note: the values of brand average are almost the same with your post except the brands "GO 1200R20 AZ0026 CHI" and "GO 1200R20 AZ0083 CHI" .

VBA Code:
Sub Price_Average()
    Application.ScreenUpdating = False
    Dim SV As Worksheet
    Set SV = Worksheets("SV")
    Dim Rng1 As Range
    Set Rng1 = SV.Range("A1").CurrentRegion
    Rows1 = Rng1.Rows.Count
    Set Rng1 = Rng1.Offset(0, 5).Resize(Rows1, 4)
    
    Dim STOCK As Worksheet
    Set STOCK = Worksheets("STOCK")
    Dim Rng2 As Range
    Set Rng2 = STOCK.Range("A1").CurrentRegion
    Rows2 = Rng2.Rows.Count - 1
    Set Rng2 = Rng2.Offset(1, 1).Resize(Rows2, 4)
    
    Dim temp As Worksheet
    Set temp = Worksheets.Add
    temp.Range("A1").Resize(Rows1, 4) = Rng1.Value
    temp.Range("A1").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    temp.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(Rows2, 4) = Rng2.Value
    
    Dim Table As Range
    Set Table = temp.Range("A1").CurrentRegion.Offset(1)
    Rows_Table = Table.Rows.Count - 1
    Set Table = Table.Resize(Rows_Table)
    
    Dim Brand As Range
    Set Brand = Table.Columns("A")
    Brand_unique = GetUniqueValues(Brand.Value)
    Brand_unique_count = UBound(Brand_unique) + 1
    
    Dim Qty As Range
    Set Qty = Table.Columns("B")
    
    Dim Price As Range
    Set Price = Table.Columns("C")
    
    'Brand
    temp.Range("G1").Resize(Brand_unique_count) = WorksheetFunction.Transpose(Brand_unique)
    Dim Brand_G1 As Range
    Set Brand_G1 = temp.Range("G1").CurrentRegion
    
    'Item No.
    temp.Range("F1").Resize(Brand_unique_count) = WorksheetFunction.Sequence(Brand_unique_count)
    'PRICE AVERAGE
    temp.Range("H1").Formula2 = "=LET(x_1," & Brand.Address & _
                                   ", x_2," & Qty.Address & _
                                   ", x_3," & Price.Address & _
                                   ", x_4," & Brand_G1.Address & _
                                   ", SCAN("""", x_4, LAMBDA(acc,x, SUM((x_1 = x) * x_3) / COUNTIF(x_1, x))))"
    Dim Result As Range
    Set Result = temp.Range("H1").CurrentRegion

    Dim REPORT As Worksheet
    Set REPORT = Worksheets("REPORT")
    Dim Rng3 As Range
    Set Rng3 = REPORT.Range("A1")
    Rng3.CurrentRegion.ClearContents
    Rng3.Range("A1") = "Item"
    Rng3.Range("B1") = "Brand"
    Rng3.Range("C1") = "PRICE AVERAGE"
    Result.Copy
    Rng3.Offset(1).PasteSpecial xlPasteValues
    REPORT.Select
    Rng3.Activate
    
    Application.DisplayAlerts = False
    temp.Delete
    Application.DisplayAlerts = True
End Sub

Function GetUniqueValues(arr)
    Dim dict As Object
    Dim uniqueArr() As Variant
    Dim i As Integer
    
    Set dict = CreateObject("Scripting.Dictionary")
    
    For i = LBound(arr) To UBound(arr)
        If Not dict.exists(arr(i, 1)) Then
            dict.Add arr(i, 1), Nothing
        End If
    Next i
    
    GetUniqueValues = dict.Keys
End Function
 
Upvote 0
Try this:

VBA Code:
Sub Merge_price_as_average()
  Dim dic As Object
  Dim a As Variant, b As Variant, c As Variant, ky As Variant
  Dim i As Long, k As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  a = Sheets("SV").Range("A2", Sheets("SV").Range("E" & Rows.Count).End(3)).Value
  b = Sheets("STOCK").Range("A2", Sheets("STOCK").Range("I" & Rows.Count).End(3)).Value
  ReDim c(1 To UBound(a, 1) + UBound(a, 2), 1 To 3)
  
  For i = 1 To UBound(a, 1)
    If a(i, 2) <> "" Then _
      If Not dic.exists(a(i, 2)) Then dic(a(i, 2)) = a(i, 4) & "|" & 1 Else _
        dic(a(i, 2)) = a(i, 4) + Split(dic(a(i, 2)), "|")(0) & "|" & Split(dic(a(i, 2)), "|")(1) + 1
  Next
  For i = 1 To UBound(b, 1)
    If b(i, 6) <> "" Then _
      If Not dic.exists(b(i, 6)) Then dic(b(i, 6)) = b(i, 8) & "|" & 1 Else _
        dic(b(i, 6)) = b(i, 8) + Split(dic(b(i, 6)), "|")(0) & "|" & Split(dic(b(i, 6)), "|")(1) + 1
  Next
  For Each ky In dic.keys
    k = k + 1
    c(k, 1) = k
    c(k, 2) = ky
    c(k, 3) = Split(dic(ky), "|")(0) / Split(dic(ky), "|")(1)
  Next
  
  Sheets("REPORT").Range("A2").Resize(k, 3).Value = c
End Sub
 
Upvote 0
Try again.
Note: the values of brand average are almost the same with your post except the brands "GO 1200R20 AZ0026 CHI" and "GO 1200R20 AZ0083 CHI" .
gives me error error unable to get the sequence property of worksheetfunction
 
Upvote 0
try this.
VBA Code:
Sub Price_Average()
    Application.ScreenUpdating = False
    Dim SV As Worksheet
    Set SV = Worksheets("SV")
    Dim Rng1 As Range
    Set Rng1 = SV.Range("A1").CurrentRegion
    Rows1 = Rng1.Rows.Count - 1
    SV_Brand = Rng1.Offset(1).Resize(Rows1).Columns("F")
    SV_Price = Rng1.Offset(1).Resize(Rows1).Columns("H")
    
    
    Dim STOCK As Worksheet
    Set STOCK = Worksheets("STOCK")
    Dim Rng2 As Range
    Set Rng2 = STOCK.Range("A1").CurrentRegion
    Rows2 = Rng2.Rows.Count - 1
    STOCK_Brand = Rng2.Offset(1).Resize(Rows2).Columns("B")
    STOCK_Price = Rng2.Offset(1).Resize(Rows2).Columns("D")
    
    Dim Brand_Count As Object
    Set Brand_Count = CreateObject("Scripting.Dictionary")
    Dim Brand_Price As Object
    Set Brand_Price = CreateObject("Scripting.Dictionary")
    
    For Each x In SV_Brand
        i = i + 1
        If Brand_Count.exists(x) Then
            Brand_Count.Item(x) = Brand_Count.Item(x) + 1
            Brand_Price.Item(x) = Brand_Price.Item(x) + SV_Price(i, 1)
        ElseIf x = "" Then
        Else
            Brand_Count.Add x, 1
            Brand_Price.Add x, SV_Price(i, 1)
        End If
    Next x
    i = 0
    For Each x In STOCK_Brand
        i = i + 1
        If Brand_Count.exists(x) Then
            Brand_Count.Item(x) = Brand_Count.Item(x) + 1
            Brand_Price.Item(x) = Brand_Price.Item(x) + STOCK_Price(i, 1)
        ElseIf x = "" Then
        Else
            Brand_Count.Add x, 1
            Brand_Price.Add x, STOCK_Price(i, 1)
        End If
    Next x
    
    Dim Report_Item
    ReDim Report_Item(1 To Brand_Price.Count, 1 To 1)
    Dim Report_Brand
    ReDim Report_Brand(1 To Brand_Price.Count, 1 To 1)
    Dim Average_Price
    ReDim Average_Price(1 To Brand_Price.Count, 1 To 1)
    Brand_Prices = Brand_Price.Items
    Brand_Counts = Brand_Count.Items
    Brands = Brand_Price.keys
    For i = 0 To Brand_Price.Count - 1
        Report_Item(i + 1, 1) = i + 1
        Report_Brand(i + 1, 1) = Brands(i)
        Average_Price(i + 1, 1) = Brand_Prices(i) / Brand_Counts(i)
    Next i
        
    Dim REPORT As Worksheet
    Set REPORT = Worksheets("REPORT")
    Dim Rng3 As Range
    Set Rng3 = REPORT.Range("A1")
    Rng3.CurrentRegion.ClearContents
    Rng3.Range("A1") = "Item"
    Rng3.Range("A2").Resize(Brand_Price.Count) = Report_Item
    Rng3.Range("B1") = "Brand"
    Rng3.Range("B2").Resize(Brand_Price.Count) = Report_Brand
    Rng3.Range("C1") = "PRICE AVERAGE"
    Rng3.Range("C2").Resize(Brand_Price.Count) = Average_Price
    
    
    REPORT.Select
    Rng3.Activate
End Sub
 
Upvote 0
shows me mismatch error in this line
That's because you have text instead of numbers in some of your cells.
Perform the test with your example data so you can see how it works.

And then with your complete information.
When the error occurs, press the Debug button, on the yellow line with the error, move the mouse pointer to the word "ky", a window appears, a Brand will appear, check that Brand in your sheets to see the prices and find the problem.

1738506500683.png


Also bring the mouse closer to the word "Dic", take note of the contents of the window.

1738506788977.png


If you don't find the problem running this version, it will leave the
Brand without average price, that will give us a clue to know which Brand you have incorrect prices for.

VBA Code:
Sub Merge_price_as_average()
  Dim dic As Object
  Dim a As Variant, b As Variant, c As Variant, ky As Variant
  Dim i As Long, k As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  a = Sheets("SV").Range("A2", Sheets("SV").Range("E" & Rows.Count).End(3)).Value
  b = Sheets("STOCK").Range("A2", Sheets("STOCK").Range("I" & Rows.Count).End(3)).Value
  ReDim c(1 To UBound(a, 1) + UBound(a, 2), 1 To 3)
  
  For i = 1 To UBound(a, 1)
    If a(i, 2) <> "" Then _
      If Not dic.exists(a(i, 2)) Then dic(a(i, 2)) = a(i, 4) & "|" & 1 Else _
        dic(a(i, 2)) = a(i, 4) + Split(dic(a(i, 2)), "|")(0) & "|" & Split(dic(a(i, 2)), "|")(1) + 1
  Next
  For i = 1 To UBound(b, 1)
    If b(i, 6) <> "" Then _
      If Not dic.exists(b(i, 6)) Then dic(b(i, 6)) = b(i, 8) & "|" & 1 Else _
        dic(b(i, 6)) = b(i, 8) + Split(dic(b(i, 6)), "|")(0) & "|" & Split(dic(b(i, 6)), "|")(1) + 1
  Next
  
  For Each ky In dic.keys
    k = k + 1
    c(k, 1) = k
    c(k, 2) = ky
    On Error Resume Next
    c(k, 3) = Split(dic(ky), "|")(0) / Split(dic(ky), "|")(1)
    On Error GoTo 0
  Next
  
  Sheets("REPORT").Range("A2").Resize(k, 3).Value = c
End Sub

If you still don't find the problem, share your file in the cloud, in Google Drive or Dropbox and I will review it.

😅
 
Upvote 0

Forum statistics

Threads
1,226,269
Messages
6,189,956
Members
453,584
Latest member
daihoctuxaeptit

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