Printable View
Hi
I would like to sort the following table and sum cost for the three parameters
Query
Output
Parameter1 Parameter2 Parameter3(m) Cost 1 a 100 30 1 a 100 10 1 c 200 30 2 b 700 20 2 b 700 10 1 a 200 70 1 c 200 40
Parameter1 Parameter2 Parameter3 TotalCost 1 a 100 40 1 a 200 70 1 c 200 70 2 b 700 30
welcome to the forum
how about a pivot table?
Parameter1, Parameter2, Parameter3(m) to the rows area and Cost to the values area.
show pt in tabular form.
"repeat item labels" for Parameter1 and Parameter2.
Attachment 22357
Hi Thanks I already put it in a pivot table but I would like to vba code it as I want to add more restrictions to the code. for instance i actually want to limit the cost to a 100. if the cost goes over 100, I want to write the same parameters on the next lineThanks for the feedback. I hope to hear from you soon.
Parameter1 Parameter2 Parameter3 cost 1 a 100 100 (reached 100, so write remainder on next line) 1 a 100 100 1 a 100 70
assuming A1:A8 of Sheet1 houses your table, below code will do what you asked for in post #1
summary table will be written to H1:K5 on the same sheet.
your request in post #3 is totally different and i am not sure i can follow you.Code:Sub vbax_62884_sum_based_on_multi_crit_uniquity()
Dim scrDic As Object
Dim i As Long, rw As Long
Dim arr, dx, k
Set scrDic = CreateObject("Scripting.Dictionary")
scrDic.CompareMode = vbTextCompare
With Sheets("Sheet1")
.Cells(1).Sort Key1:=.Range("A2"), Order1:=xlAscending, _
Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlYes
arr = .Cells(1).CurrentRegion.Value
End With
For i = LBound(arr, 1) + 1 To UBound(arr, 1)
dx = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)
If Not scrDic.Exists(dx) Then
scrDic.Add dx, arr(i, 4)
Else
scrDic(dx) = scrDic(dx) + arr(i, 4)
End If
Next i
With Sheets("Sheet1")
.Range("H1").CurrentRegion.ClearContents
rw = 2
.Range("H1").Resize(, 4).Value = Application.Index(arr, 1, 0)
For Each k In scrDic
.Range("H" & rw).Resize(, 3) = Split(k, "|")
.Range("K" & rw) = Split(scrDic(k), "|")(0)
rw = rw + 1
Next k
End With
End Sub
Quote:
Originally Posted by mancubus
Hi Thanks a million. It works perfectly. Sorry let me elaborate further to post 3.
I have the same data as post 1. Only i added the 6th column total for you to follow. the total is the summation of the cost for parameter 1,2 and 3.
Parameter1 Parameter2 Parameter3:Dimension Parameter4:Cost Total 1 a 100 130 240 1 a 100 110 1 a 200 270 580 1 c 200 30 1 c 200 280 2 b 700 20 130 2 b 700 110
I would like to represent the data as:
Parameter1 Parameter2 Parameter3 Parameter4:Cost 1 a 100 100 1 a 100 100 1 a 100 40 1 b 200 100 1 b 200 100 1 b 200 100 1 b 200 100 1 b 200 100 1 b 200 80 2 c 700 100 2 c 700 30
The cost should take the total sum and split it into 100's in each row. if 100 cannot be made it should take the balance. Please refer to the table above.
Thank you again for the speedy response
post your workbook pls
(see 2 in my signature)
input and output tables' parameters do not match.
Attachment 22380Quote:
Originally Posted by mancubus
with the help of a small PT...
Code:Sub vbax_62884_distribute_sums_to_rows_based_on_threshold()
Dim pt As PivotTable
Dim i As Long, j As Long, rw As Long, dRows As Double
Dim arr
Const MaxCost As Long = 100
With Sheets("Sheet1") 'Change "Sheet1" to suit
For Each pt In .PivotTables 'clear existing PTs
pt.TableRange2.Clear
Next pt
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=.Cells(1).CurrentRegion, _
Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:=.Cells(2, 200), _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion15
Set pt = .PivotTables("PivotTable1")
End With
With pt.PivotFields("Parameter 1") 'change "Parameter 1" to column A header
.Orientation = xlRowField
.Position = 1
.Subtotals(1) = False
.RepeatLabels = True
End With
With pt.PivotFields("Parameter 2") 'change "Parameter 2" to column B header
.Orientation = xlRowField
.Position = 2
.Subtotals(1) = False
.RepeatLabels = True
End With
With pt.PivotFields("Parameter 3") 'change "Parameter 3" to column C header
.Orientation = xlRowField
.Position = 3
.Subtotals(1) = False
End With
With pt
.AddDataField pt.PivotFields("Parameter 4: Cost"), "Cost", xlSum '"Parameter 4: Cost" changed to "Cost"
.RowAxisLayout xlTabularRow
.ColumnGrand = False
.RowGrand = False
arr = .TableRange2.Value
.TableRange2.Clear
End With
rw = 1
With Sheets("Sheet1") 'Change "Sheet1" to suit
.Range("H1").CurrentRegion.ClearContents
.Range("H1").Resize(, 4).Value = Application.Index(arr, 1, 0)
For i = LBound(arr) + 1 To UBound(arr)
dRows = arr(i, 4) / MaxCost
If dRows <= 1 Then
rw = rw + 1
.Range("H" & rw).Resize(, 3).Value = Application.Index(arr, i, 0)
.Range("K" & rw) = arr(i, 4)
Else
For j = 1 To Int(dRows)
rw = rw + 1
.Range("H" & rw).Resize(, 3).Value = Application.Index(arr, i, 0)
.Range("K" & rw) = MaxCost
Next j
rw = rw + 1
.Range("H" & rw).Resize(, 3).Value = Application.Index(arr, i, 0)
.Range("K" & rw) = arr(i, 4) Mod MaxCost
End If
Next i
End With
End Sub
Hi thanks for the code. I cannot seem to pass this error: invalid procedure or argument call for the following piece of code:
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=.Cells(1).CurrentRegion, _
Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:=.Cells(2, 200), _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion15-----------------error lies in this line
Please assist
Thank you in advance
Nevermind. I fixed it. I changed "xlPivotTableVersion15' to xlPivotTableVersion14