This commit is contained in:
louiscklaw
2025-01-31 21:36:48 +08:00
parent 8ee1ccbebc
commit 2e592cb561
248 changed files with 11958 additions and 0 deletions

View File

@@ -0,0 +1,392 @@
Attribute VB_Name = "APAnalysis"
Global AgentPerformanceAnalysisHelloworld As String
Global AgentPerformanceAnalysisRankOfEachMonth(12, 5) As String
Global TempMonthlyComission(12) As String
Global SortedMonthlyComission(12) As Double
Global sortedArray As Variant
Global sort_result As Variant
' Global monthly_top_5_comission_value(12, 5) As Double
' Global monthly_top_5_comission_name(12, 5) As String
Function APAnalysis_Calc(ByVal TablesMeta As Variant) As Variant
Dim agent_sales_table As Variant
Dim product_sales_meta As Variant
Dim product_sales_table As Variant
Dim monthly_top_5_comission_value(12, 5) As Double
Dim monthly_top_5_comission_name(12, 5) As String
agent_sales_table = TablesMeta(0)
Dim agent_sales_table_rows As Variant
agent_sales_table_rows = agent_sales_table(0)
product_sales_table = TablesMeta(1)
Dim product_sales_table_row As Variant
product_sales_table_row = product_sales_table(0)
agent_working_performance = TablesMeta(2)
Dim val_product_sales_comission As String
Dim val_product_sales_selling_price As String
Dim val_product_sales_selling_unit As String
Dim val_agent_sale_commision_pct As String
Dim val_agent_sale_agent_name As String
Dim val_agent_sale_agent_team As String
Dim monthly_commission(12) As Double
Dim montyly_commission_TA(12) As Double
Dim montyly_commission_TB(12) As Double
Dim quartely_commission_TA(12) As Double
Dim quartely_commission_TB(12) As Double
For ps = 1 To product_sales_table(1)
val_product_sales_date = product_sales_table_row(ps, 2)
dt = DateValue(val_product_sales_date)
intMonth = month(dt)
intQuarter = Int((intMonth - 1) / 3) + 1
val_product_sales_selling_unit = product_sales_table_row(ps, 4)
val_product_sales_selling_price = product_sales_table_row(ps, 5)
val_agent_sale_agent_name = agent_sales_table_rows(ps, 3)
val_agent_sale_agent_team = agent_sales_table_rows(ps, 4)
val_agent_sale_commision_pct = agent_sales_table_rows(ps, 6)
val_product_sales_comission = val_product_sales_selling_unit * val_product_sales_selling_price * val_agent_sale_commision_pct
product_sales_table_row(ps, 6) = val_product_sales_comission
Dim temp_key As String
temp_key = val_agent_sale_agent_name + "," + CStr(intMonth)
If (Not (IsEmpty(temp_key)) And Not (monthly_commission_per_agent.exists(temp_key))) Then
For j = 1 To 12
monthly_commission_per_agent(val_agent_sale_agent_name + "," + CStr(j)) = 0
Next j
End If
monthly_commission_per_agent(temp_key) = monthly_commission_per_agent(temp_key) + val_product_sales_comission
monthly_commission(intMonth) = monthly_commission(intMonth) + val_product_sales_comission
If (val_agent_sale_agent_team = "A") Then
montyly_commission_TA(intMonth) = montyly_commission_TA(intMonth) + val_product_sales_comission
End If
If (val_agent_sale_agent_team = "B") Then
montyly_commission_TB(intMonth) = montyly_commission_TB(intMonth) + val_product_sales_comission
End If
If (val_agent_sale_agent_team = "A") Then
quartely_commission_TA(intQuarter) = quartely_commission_TA(intQuarter) + val_product_sales_comission
End If
If (val_agent_sale_agent_team = "B") Then
quartely_commission_TB(intQuarter) = quartely_commission_TB(intQuarter) + val_product_sales_comission
End If
Next ps
For m = 1 To 12
Dim temp_sort(20) As Double
i = 0
For Each sales_name In SALES_ARRAY
temp_key = sales_name + "," + CStr(m)
temp_sort(i) = monthly_commission_per_agent(temp_key)
i = i + 1
Next sales_name
sort_result = SortArray(temp_sort)
monthly_top_5_comission_value(m, 0) = sort_result(0)
monthly_top_5_comission_value(m, 1) = sort_result(1)
monthly_top_5_comission_value(m, 2) = sort_result(2)
monthly_top_5_comission_value(m, 3) = sort_result(3)
monthly_top_5_comission_value(m, 4) = sort_result(4)
For Each sales_name In SALES_ARRAY
temp_key = sales_name + "," + CStr(m)
If (monthly_top_5_comission_value(m, 0) = monthly_commission_per_agent(temp_key)) Then
monthly_top_5_comission_name(m, 0) = sales_name
End If
If (monthly_top_5_comission_value(m, 1) = monthly_commission_per_agent(temp_key)) Then
monthly_top_5_comission_name(m, 1) = sales_name
End If
If (monthly_top_5_comission_value(m, 2) = monthly_commission_per_agent(temp_key)) Then
monthly_top_5_comission_name(m, 2) = sales_name
End If
If (monthly_top_5_comission_value(m, 3) = monthly_commission_per_agent(temp_key)) Then
monthly_top_5_comission_name(m, 3) = sales_name
End If
If (monthly_top_5_comission_value(m, 4) = monthly_commission_per_agent(temp_key)) Then
monthly_top_5_comission_name(m, 4) = sales_name
End If
Next sales_name
Next m
Debug.Print "helloworld"
APAnalysis_Calc = Array(monthly_commission_per_agent, monthly_commission, montyly_commission_TA, montyly_commission_TB, quartely_commission_TA, quartely_commission_TB, monthly_top_5_comission_name, monthly_top_5_comission_value)
End Function
Function APAnalysis_WriteTable(ByVal calc_result As Variant, ByVal FILE_PATH As String)
Dim monthly_commission As Variant
Dim montyly_commission_TA As Variant
Dim montyly_commission_TB As Variant
Dim monthly_top_5_comission_name As Variant
Dim monthly_top_5_comission_value As Variant
monthly_commission = calc_result(1)
montyly_commission_TA = calc_result(2)
montyly_commission_TB = calc_result(3)
quartely_commission_TA = calc_result(4)
quartely_commission_TB = calc_result(5)
monthly_top_5_comission_name = calc_result(6)
monthly_top_5_comission_value = calc_result(7)
Const TOP_ROW As Long = 1
Const START_CELL As String = "A2"
Dim wb As Workbook
Dim ws As Worksheet
Dim startCell As Range
Dim i As Long
Dim tempArray() As Variant
' Open the workbook
Set wb = Workbooks.Open(FILE_PATH)
' Check if the sheet exists
On Error Resume Next
Set ws = wb.Sheets("Agent performance analysis")
On Error GoTo 0
' If not found, create a new sheet
If ws Is Nothing Then
Set ws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
ws.Name = "Agent performance analysis"
Else
' Empty the entire sheet
ws.UsedRange.ClearContents
End If
' Write month names
Set startCell = ws.Range("B1")
tempArray = Array("January", "Feburary", "March", "April", "May", "June", "July", "Augest", "September", "October", "November", "December")
For i = LBound(tempArray) To UBound(tempArray)
startCell.Offset(0, i).Value = tempArray(i)
Next i
' Write month names
Set startCell = ws.Range("A2")
For i = LBound(SALES_ARRAY) To UBound(SALES_ARRAY)
startCell.Offset(i, 0).Value = SALES_ARRAY(i)
Next i
' Write month names
Set startCell = ws.Range("A14")
tempArray = Array("Total", "", "Team A total", "Team B Total", "Team A Quartely", "Team B Quartely")
For i = LBound(tempArray) To UBound(tempArray)
startCell.Offset(i, 0).Value = tempArray(i)
Next i
Set startCell = ws.Range("B2")
For m = 1 To 12
For i = LBound(SALES_ARRAY) To UBound(SALES_ARRAY)
Dim sales_name As String
sale_name_comma_month = SALES_ARRAY(i) + "," + CStr(m)
startCell.Offset(i, m - 1).Value = monthly_commission_per_agent(sale_name_comma_month)
Next i
Next m
' Write month names
Set startCell = ws.Range("B14")
tempArray = Array("Total", "", "Team A total", "Team B Total", "Team A Quartely", "Team B Quartely")
' For i = LBound(tempArray) To UBound(tempArray)
' startCell.Offset(i, 0).Value = tempArray(i)
' Next i
For m = 1 To 12
Dim intQuarter As Integer
intQuarter = Int((m - 1) / 3) + 1
startCell.Offset(0, m - 1).Value = monthly_commission(m)
startCell.Offset(2, m - 1).Value = montyly_commission_TA(m)
startCell.Offset(3, m - 1).Value = montyly_commission_TB(m)
startCell.Offset(4, m - 1).Value = quartely_commission_TA(intQuarter)
startCell.Offset(5, m - 1).Value = quartely_commission_TB(intQuarter)
Next m
' styling
For i = 0 To 100
ws.Range("A1").Offset(0, i).EntireColumn.AutoFit
Next i
For i = 1 To 14
Range("A1").Offset(0, i).EntireColumn.ColumnWidth = 15
Next i
Dim ranges_need_merge As Variant
ranges_need_merge = Array("B18:D18", "E18:G18", "H18:J18", "K18:M18", "B19:D19", "E19:G19", "H19:J19", "K19:M19")
For r = LBound(ranges_need_merge) To UBound(ranges_need_merge)
range_need_merge = ranges_need_merge(r)
With Range(range_need_merge)
.Merge
.VerticalAlignment = xlVAlignCenter
.HorizontalAlignment = xlHAlignCenter
End With
Next r
Dim ranges_need_paint As Variant
ranges_need_paint = Array("B1:M1")
For r = LBound(ranges_need_paint) To UBound(ranges_need_paint)
range_need_merge = ranges_need_paint(r)
With Range(range_need_merge)
.Interior.Color = RGB(217, 210, 233)
End With
Next r
ranges_need_paint = Array("A2:A11", "A14")
For r = LBound(ranges_need_paint) To UBound(ranges_need_paint)
range_need_merge = ranges_need_paint(r)
With Range(range_need_merge)
.Interior.Color = RGB(180, 167, 214)
End With
Next r
ranges_need_paint = Array("A16:A19")
For r = LBound(ranges_need_paint) To UBound(ranges_need_paint)
range_need_merge = ranges_need_paint(r)
With Range(range_need_merge)
.Interior.Color = RGB(142, 124, 195)
End With
Next r
' Rank for each month
Set startCell = ws.Range("A21")
startCell.Value = "Rank for each month"
tempArray = Array("January", "Feburary", "March", "April", "May", "June")
For i = 0 To 5
startCell.Offset(1, (i * 2) + 1).Value = tempArray(i)
Next i
For i = 1 To 5
startCell.Offset(i + 1, 0).Value = i
Next i
tempArray = Array("July", "Augest", "September", "October", "November", "December")
For i = 0 To 5
startCell.Offset(8, (i * 2) + 1).Value = tempArray(i)
Next i
For i = 1 To 5
startCell.Offset(i + 8, 0).Value = i
Next i
For m = 1 To 6
i = m - 1
startCell.Offset(2, (i * 2) + 1).Value = monthly_top_5_comission_name(m, 0)
startCell.Offset(3, (i * 2) + 1).Value = monthly_top_5_comission_name(m, 1)
startCell.Offset(4, (i * 2) + 1).Value = monthly_top_5_comission_name(m, 2)
startCell.Offset(5, (i * 2) + 1).Value = monthly_top_5_comission_name(m, 3)
startCell.Offset(6, (i * 2) + 1).Value = monthly_top_5_comission_name(m, 4)
startCell.Offset(2, (i * 2) + 2).Value = monthly_top_5_comission_value(m, 0)
startCell.Offset(3, (i * 2) + 2).Value = monthly_top_5_comission_value(m, 1)
startCell.Offset(4, (i * 2) + 2).Value = monthly_top_5_comission_value(m, 2)
startCell.Offset(5, (i * 2) + 2).Value = monthly_top_5_comission_value(m, 3)
startCell.Offset(6, (i * 2) + 2).Value = monthly_top_5_comission_value(m, 4)
Next m
For m = 7 To 12
i = m - 7
startCell.Offset(9, (i * 2) + 1).Value = monthly_top_5_comission_name(m, 0)
startCell.Offset(10, (i * 2) + 1).Value = monthly_top_5_comission_name(m, 1)
startCell.Offset(11, (i * 2) + 1).Value = monthly_top_5_comission_name(m, 2)
startCell.Offset(12, (i * 2) + 1).Value = monthly_top_5_comission_name(m, 3)
startCell.Offset(13, (i * 2) + 1).Value = monthly_top_5_comission_name(m, 4)
startCell.Offset(9, (i * 2) + 2).Value = monthly_top_5_comission_value(m, 0)
startCell.Offset(10, (i * 2) + 2).Value = monthly_top_5_comission_value(m, 1)
startCell.Offset(11, (i * 2) + 2).Value = monthly_top_5_comission_value(m, 2)
startCell.Offset(12, (i * 2) + 2).Value = monthly_top_5_comission_value(m, 3)
startCell.Offset(13, (i * 2) + 2).Value = monthly_top_5_comission_value(m, 4)
Next m
' styling
For i = 0 To 100
ws.Range("A1").Offset(0, i).EntireColumn.AutoFit
Next i
For i = 1 To 14
Range("A1").Offset(0, i).EntireColumn.ColumnWidth = 15
Next i
ranges_need_merge = Array("B22:C22", "D22:E22", "F22:G22", "H22:I22", "J22:k22", "L22:M22", "B29:C29", "D29:E29", "F29:G29", "H29:I29", "J29:k29", "L29:M29")
For r = LBound(ranges_need_merge) To UBound(ranges_need_merge)
range_need_merge = ranges_need_merge(r)
With Range(range_need_merge)
.Merge
.VerticalAlignment = xlVAlignCenter
.HorizontalAlignment = xlHAlignCenter
End With
Next r
ranges_need_paint = Array("B22:C22", "D22:E22", "F22:G22", "H22:I22", "J22:k22", "L22:M22", "B29:C29", "D29:E29", "F29:G29", "H29:I29", "J29:k29", "L29:M29")
For r = LBound(ranges_need_paint) To UBound(ranges_need_paint)
range_need_merge = ranges_need_paint(r)
With Range(range_need_merge)
.Interior.Color = RGB(234, 209, 220)
End With
Next r
ranges_need_paint = Array("A21", "A23", "A25", "A27", "A30", "A32", "A34")
For r = LBound(ranges_need_paint) To UBound(ranges_need_paint)
range_need_merge = ranges_need_paint(r)
With Range(range_need_merge)
.Interior.Color = RGB(234, 209, 220)
End With
Next r
' Save and close the workbook
' wb.Close SaveChanges:=True
End Function

View File

@@ -0,0 +1,223 @@
Attribute VB_Name = "APAnalysisGraph"
Function TeamATotalSalesCommisionPerformanceTable(ByVal calc_result As Variant, ByVal FILE_PATH As String)
Dim wb As Workbook
Dim ws As Worksheet
Dim startCell As Range
Dim monthly_commission As Variant
Dim montyly_commission_TA As Variant
monthly_commission = calc_result(1)
montyly_commission_TA = calc_result(2)
Dim monthNames() As Variant
monthNames = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
' Open the workbook
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Agent performance analysis")
' Write headers
Set startCell = ws.Range("A1")
startCell.Value = "Team A Total Sales Commision Performance"
startCell.Offset(1, 0).Value = "Month"
startCell.Offset(1, 1).Value = "Amount"
Set startCell = ws.Range("A3")
For m = LBound(monthNames) To UBound(monthNames)
startCell.Offset(m, 0).Value = monthNames(m)
startCell.Offset(m, 1).Value = montyly_commission_TA(m + 1)
Next m
' Save and close the workbook
' wb.Close SaveChanges:=True
End Function
Function TeamBTotalSalesCommisionPerformanceTable(ByVal calc_result As Variant, ByVal FILE_PATH As String)
Dim wb As Workbook
Dim ws As Worksheet
Dim startCell As Range
Dim monthly_commission As Variant
Dim montyly_commission_TB As Variant
monthly_commission = calc_result(1)
montyly_commission_TB = calc_result(3)
Dim monthNames() As Variant
monthNames = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
' Open the workbook
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Agent performance analysis")
' Write headers
Set startCell = ws.Range("A20")
startCell.Value = "Team B Total Sales Commision Performance"
startCell.Offset(1, 0).Value = "Month"
startCell.Offset(1, 1).Value = "Amount"
Set startCell = ws.Range("A22")
For m = LBound(monthNames) To UBound(monthNames)
startCell.Offset(m, 0).Value = monthNames(m)
startCell.Offset(m, 1).Value = montyly_commission_TB(m + 1)
Next m
' Save and close the workbook
' wb.Close SaveChanges:=True
End Function
Function TeamATotalSalesCommisionPerformanceGraph(ByVal calc_result As Variant, ByVal FILE_PATH As String)
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Agent performance analysis")
Dim cht As Chart
Dim ax As Axis
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
Set cho = ws.ChartObjects(ws.ChartObjects.Count)
Set cht = cho.Chart
cht.SetSourceData Source:=Range("A2:B14")
cht.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
Selection.Format.TextFrame2.TextRange.Characters.Text = "Month"
cht.SetElement (msoElementPrimaryValueAxisTitleAdjacentToAxis)
cht.ChartTitle.Text = "Team A total Sales commision performance"
Set ax = cht.Axes(xlValue, xlPrimary)
ax.HasTitle = True
ax.AxisTitle.Format.TextFrame2.TextRange.Characters.Text = "Amount"
cho.Top = 0
cho.Left = 0
cho.Width = 400
cho.Height = 300
End Function
Function TeamBTotalSalesCommisionPerformanceGraph(ByVal calc_result As Variant, ByVal FILE_PATH As String)
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Agent performance analysis")
Dim cht As Chart
Dim ax As Axis
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
Set cho = ws.ChartObjects(ws.ChartObjects.Count)
Set cht = cho.Chart
cht.SetSourceData Source:=Range("A21:B33")
cht.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
Selection.Format.TextFrame2.TextRange.Characters.Text = "Month"
cht.SetElement (msoElementPrimaryValueAxisTitleAdjacentToAxis)
cht.ChartTitle.Text = "Team B total Sales commision performance"
Set ax = cht.Axes(xlValue, xlPrimary)
ax.HasTitle = True
ax.AxisTitle.Format.TextFrame2.TextRange.Characters.Text = "Amount"
cho.Top = 300
cho.Left = 0
cho.Width = 400
cho.Height = 300
End Function
Function RankOfAgentSalesCommMonthlyTable(ByVal calc_result As Variant, ByVal FILE_PATH As String)
Const HEADER_ROW As Long = 1
Const START_CELL As String = "F1"
Dim wb As Workbook
Dim ws As Worksheet
Dim startCell As Range
Dim monthly_top_5_comission_name As Variant
Dim monthly_top_5_comission_value As Variant
monthly_top_5_comission_name = calc_result(6)
monthly_top_5_comission_value = calc_result(7)
' Open the workbook
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Agent performance analysis")
' Write headers
Set startCell = ws.Range(START_CELL)
startCell.Offset(0, 0).Value = "Top 5 Agent's Commssion"
for m = LBound(MONTH_NAMES) to UBound(MONTH_NAMES)
startCell.Offset(1, 0+(m*3)).Value = "Name"
startCell.Offset(1, 1+(m*3)).Value = "Commssion"
startCell.Offset(1+1, 0+(m*3)).Value = monthly_top_5_comission_name(m+1,0)
startCell.Offset(1+2, 0+(m*3)).Value = monthly_top_5_comission_name(m+1,1)
startCell.Offset(1+3, 0+(m*3)).Value = monthly_top_5_comission_name(m+1,2)
startCell.Offset(1+4, 0+(m*3)).Value = monthly_top_5_comission_name(m+1,3)
startCell.Offset(1+5, 0+(m*3)).Value = monthly_top_5_comission_name(m+1,4)
startCell.Offset(1+1, 1+(m*3)).Value = monthly_top_5_comission_value(m+1,0)
startCell.Offset(1+2, 1+(m*3)).Value = monthly_top_5_comission_value(m+1,1)
startCell.Offset(1+3, 1+(m*3)).Value = monthly_top_5_comission_value(m+1,2)
startCell.Offset(1+4, 1+(m*3)).Value = monthly_top_5_comission_value(m+1,3)
startCell.Offset(1+5, 1+(m*3)).Value = monthly_top_5_comission_value(m+1,4)
next m
' Save and close the workbook
' wb.Close SaveChanges:=True
End Function
Function RankOfAgentSalesCommMonthlyGraph(ByVal calc_result As Variant, ByVal FILE_PATH As String)
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Agent performance analysis")
Dim DATA_RANGES As Variant
DATA_RANGES = Array("F2:G7", "I2:J7","L2:M7","O2:P7","R2:S7","U2:V7","X2:Y7","AA2:AB7","AD2:AE7","AG2:AH7","AJ2:AK7","AM2:AN7")
Dim GRAPH_TOPS as variant
Dim GRAPH_LEFTS as variant
GRAPH_TOPS = Array(0,0,0,200,200,200,400,400,400,600,600,600)
GRAPH_LEFTS = Array(400,700,1000,400,700,1000,400,700,1000,400,700,1000)
For m = LBound(MONTH_NAMES) to UBound(MONTH_NAMES)
month_name = MONTH_NAMES(m)
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
Set cho = ws.ChartObjects(ws.ChartObjects.Count)
Set cht = cho.Chart
ActiveChart.SetSourceData Source:=Range(DATA_RANGES(m))
ActiveChart.ChartTitle.Text = "Top 5 Sales Commission " & month_name
cht.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
Selection.Format.TextFrame2.TextRange.Characters.Text = "Name"
cht.SetElement (msoElementPrimaryValueAxisTitleAdjacentToAxis)
Set ax = cht.Axes(xlValue, xlPrimary)
ax.HasTitle = True
ax.AxisTitle.Format.TextFrame2.TextRange.Characters.Text = "Commission"
cho.Top = GRAPH_TOPS(m)
cho.Left = GRAPH_LEFTS(m)
cho.Width = 300
cho.Height = 200
next m
End Function
Function Helloworld()
Debug.Print "helloworld Sales_Analysis_Product_Category"
End Function

View File

@@ -0,0 +1,125 @@
Attribute VB_Name = "CasePersistencyGraph"
Function TeamACaseDistributionTable(ByVal calc_result As Variant, ByVal FILE_PATH As String)
Const HEADER_ROW As Long = 1
Const START_CELL As String = "A1"
Dim wb As Workbook
Dim ws As Worksheet
Dim startCell As Range
Dim case_team_a_meta As Variant
Dim case_team_b_meta As Variant
case_team_a_meta = calc_result(5)
case_team_b_meta = calc_result(6)
' Open the workbook
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Case persistency")
' Write headers
Set startCell = ws.Range(START_CELL)
startCell.Value = "Team A Case Distribution"
startCell.Offset(1, 0).Value = "State"
startCell.Offset(1, 1).Value = "Case"
startCell.Offset(1+1, 0).Value = "Collapse"
startCell.Offset(1+2, 0).Value = "New Case"
startCell.Offset(1+1, 1).Value = case_team_a_meta(0)
startCell.Offset(1+2, 1).Value = case_team_a_meta(1)
' TODO: replace content to real data
' Save and close the workbook
' wb.Close SaveChanges:=True
End Function
Function TeamACaseDistributionGraph(ByVal calc_result As Variant, ByVal FILE_PATH As String)
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Case persistency")
ActiveSheet.Shapes.AddChart2(251, xlPie).Select
ActiveChart.SetSourceData Source:=Range("$A$2:$B$4")
ActiveChart.SetElement (msoElementLegendNone)
ActiveChart.SetElement (msoElementDataLabelCallout)
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = "Team A case Distribution"
Selection.Format.TextFrame2.TextRange.Characters.Text = "Team A case Distribution"
Set cho = ws.ChartObjects(ws.ChartObjects.Count)
Set cht = cho.Chart
cho.Top = 0
cho.Left = 0
cho.Width = 400
cho.Height = 300
End Function
Function TeamBCaseDistributionTable(ByVal calc_result As Variant, ByVal FILE_PATH As String)
Const HEADER_ROW As Long = 1
Const START_CELL As String = "F1"
Dim wb As Workbook
Dim ws As Worksheet
Dim startCell As Range
Dim case_team_a_meta As Variant
Dim case_team_b_meta As Variant
case_team_a_meta = calc_result(5)
case_team_b_meta = calc_result(6)
' Open the workbook
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Case persistency")
' Write headers
Set startCell = ws.Range(START_CELL)
startCell.Value = "Team B Case Distribution"
startCell.Offset(1, 0).Value = "State"
startCell.Offset(1, 1).Value = "Case"
startCell.Offset(1+1, 0).Value = "Collapse"
startCell.Offset(1+2, 0).Value = "New Case"
startCell.Offset(1+1, 1).Value = case_team_b_meta(0)
startCell.Offset(1+2, 1).Value = case_team_b_meta(1)
End Function
Function TeamBCaseDistributionGraph(ByVal calc_result As Variant, ByVal FILE_PATH As String)
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Case persistency")
ActiveSheet.Shapes.AddChart2(251, xlPie).Select
ActiveChart.SetSourceData Source:=Range("F2:G4")
ActiveChart.SetElement (msoElementLegendNone)
ActiveChart.SetElement (msoElementDataLabelCallout)
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = "Team B case Distribution"
Selection.Format.TextFrame2.TextRange.Characters.Text = "Team B case Distribution"
Set cho = ws.ChartObjects(ws.ChartObjects.Count)
Set cht = cho.Chart
cho.Top = 0
cho.Left = 400
cho.Width = 400
cho.Height = 300
End Function
Function Helloworld()
Debug.Print "helloworld CasePersistency"
End Function

View File

@@ -0,0 +1,177 @@
Attribute VB_Name = "Common"
Sub test()
Dim sPath As String
Dim calc_result As Variant
Config.init
sPath = "D:\_workspace\carousell-comission-playlist\jimmycheung93\task4\_poc\parse_xlsx\parse_Agent_Sales\Agent_Sales.xlsx"
AgentSalesMeta = ReadAgentSalesWorkbook.Run(sPath)
sPath = "D:\_workspace\carousell-comission-playlist\jimmycheung93\task4\_poc\parse_xlsx\parse_Product_Sales\Product_Sales.xlsx"
ProductSalesMeta = ReadProductSalesWorkbook.Run(sPath)
sPath = "D:\_workspace\carousell-comission-playlist\jimmycheung93\task4\_poc\parse_xlsx\parse_Agent_Working_Performance\Agent_Working_Performance.xlsx"
AgentWorkingPerformanceMeta = ReadAgentWorkingPerfWorkbook.Run(sPath)
CombinedSalesMeta = Array(AgentSalesMeta, ProductSalesMeta, AgentWorkingPerformanceMeta)
Const FILE_PATH As String = "D:\_workspace\carousell-comission-playlist\jimmycheung93\task4\_poc\main_xlsm\helloworld.xlsx"
' SAMonthAndQuart
calc_result = CalcSalesAnalysisMonthlyAndQuart(CombinedSalesMeta)
WriteSalesAnalysisMonthlyAndQuart calc_result, FILE_PATH
' write sales analysis product category
' SAProductCategory
calc_result = CalcSalesAnalysisFileSalesAmount(CombinedSalesMeta)
WriteSalesAnalysisFileSalesAmount calc_result, FILE_PATH
calc_result = CalcSalesAnalysisFileSalesUnit(CombinedSalesMeta)
WriteSalesAnalysisFileSalesUnit calc_result, FILE_PATH
calc_result = APAnalysis_Calc(CombinedSalesMeta)
APAnalysis_WriteTable calc_result, FILE_PATH
calc_result = NoOfCasesTable_Calc(CombinedSalesMeta)
NoOfCasesTable_WriteTable calc_result, FILE_PATH
Debug.Print "done"
End Sub
Sub testDraftGraphData()
Dim sPath As String
Dim calc_result As Variant
Config.init
sPath = "D:\_workspace\carousell-comission-playlist\jimmycheung93\task4\_poc\parse_xlsx\parse_Agent_Sales\Agent_Sales.xlsx"
AgentSalesMeta = ReadAgentSalesWorkbook.Run(sPath)
sPath = "D:\_workspace\carousell-comission-playlist\jimmycheung93\task4\_poc\parse_xlsx\parse_Product_Sales\Product_Sales.xlsx"
ProductSalesMeta = ReadProductSalesWorkbook.Run(sPath)
sPath = "D:\_workspace\carousell-comission-playlist\jimmycheung93\task4\_poc\parse_xlsx\parse_Agent_Working_Performance\Agent_Working_Performance.xlsx"
AgentWorkingPerformanceMeta = ReadAgentWorkingPerfWorkbook.Run(sPath)
CombinedSalesMeta = Array(AgentSalesMeta, ProductSalesMeta, AgentWorkingPerformanceMeta)
Const FILE_PATH As String = "D:\_workspace\carousell-comission-playlist\jimmycheung93\task4\_poc\main_xlsm\helloworld_graph.xlsm"
' creasteXlsm(FILE_PATH)
' Sales Analysis (Monthly & Quartery)
AddSheet FILE_PATH, "Sales Analysis Monthly_Quartery"
calc_result = CalcSalesAnalysisMonthlyAndQuart(CombinedSalesMeta)
SAMonthAndQuartGraph.MonthlySalesAmountTable calc_result, FILE_PATH
SAMonthAndQuartGraph.MonthlySalesAmountGraph FILE_PATH
SAMonthAndQuartGraph.MonthlySalesComissionTable calc_result, FILE_PATH
SAMonthAndQuartGraph.MonthlySalesComissionGraph FILE_PATH
' Sales Analysis (Product Category)
AddSheet FILE_PATH, "Sales Analysis Product Category"
calc_result = CalcSalesAnalysisFileSalesAmount(CombinedSalesMeta)
SAProdCatGraph.SalesAmountTable calc_result, FILE_PATH, 1
SAProdCatGraph.SalesAmountGraph calc_result, FILE_PATH, 1
calc_result = CalcSalesAnalysisFileSalesUnit(CombinedSalesMeta)
SAProdCatGraph.SalesUnitTable calc_result, FILE_PATH, 1
SAProdCatGraph.SalesUnitGraph calc_result, FILE_PATH, 1
' Agent performance analysis(Comm
AddSheet FILE_PATH, "Agent performance analysis"
calc_result = APAnalysis_Calc(CombinedSalesMeta)
APAnalysisGraph.TeamATotalSalesCommisionPerformanceTable calc_result, FILE_PATH
APAnalysisGraph.TeamATotalSalesCommisionPerformanceGraph calc_result, FILE_PATH
APAnalysisGraph.TeamBTotalSalesCommisionPerformanceTable calc_result, FILE_PATH
APAnalysisGraph.TeamBTotalSalesCommisionPerformanceGraph calc_result, FILE_PATH
' Rank of agent's sales commission (monthly)
APAnalysisGraph.RankOfAgentSalesCommMonthlyTable calc_result, FILE_PATH
APAnalysisGraph.RankOfAgentSalesCommMonthlyGraph calc_result, FILE_PATH
' ' Case persistency
AddSheet FILE_PATH, "Case persistency"
calc_result = NoOfCasesTable_Calc(CombinedSalesMeta)
CasePersistencyGraph.TeamACaseDistributionTable calc_result, FILE_PATH
CasePersistencyGraph.TeamACaseDistributionGraph calc_result, FILE_PATH
CasePersistencyGraph.TeamBCaseDistributionTable calc_result, FILE_PATH
CasePersistencyGraph.TeamBCaseDistributionGraph calc_result, FILE_PATH
Debug.Print "done"
End Sub
Function GetQuarterFromMonth(ByVal month As Integer) As Integer
GetQuarterFromMonth = Int((month - 1) / 3) + 1
End Function
Function SortArray(ByRef arr() As Double) As Double()
Dim i As Long, j As Long
Dim temp As Variant
For i = LBound(arr) To UBound(arr) - 1
For j = i + 1 To UBound(arr)
If arr(i) < arr(j) Then
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
End If
Next j
Next i
SortArray = arr
End Function
Sub creasteXlsm(ByVal FILE_PATH As String)
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
Dim wb As Object
Set wb = xlApp.Workbooks.Add
wb.SaveAs FILE_PATH, FileFormat:=52
wb.Close SaveChanges:=True
xlApp.Quit
Set xlApp = Nothing
End Sub
Function AddSheet(ByVal FILE_PATH As String, ByVal sheet_name As String)
Dim wb As Workbook
Dim ws As Worksheet
' Open the workbook
Set wb = Workbooks.Open(FILE_PATH)
' Check if the sheet exists
On Error Resume Next
Set ws = wb.Sheets(sheet_name)
On Error GoTo 0
' If not found, create a new sheet
If ws Is Nothing Then
Set ws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
ws.Name = sheet_name
Else
' Empty the entire sheet
ws.UsedRange.ClearContents
End If
End Function

View File

@@ -0,0 +1,82 @@
Attribute VB_Name = "Config"
Global NumOfSales As Integer
Global SALES_ANALYSIS_COL_MONTH As String
Global SALES_ANALYSIS_COL_QUARTER As String
Global SALES_ANALYSIS_COL_PRODUCT_CATEGORY As String
Global SALES_ANALYSIS_COL_SELLING_UNIT As String
Global SALES_ANALYSIS_COL_MONTHLY_SALES As String
Global SALES_ANALYSIS_COL_QUARTELY_SALES As String
Global SALES_ANALYSIS_COL_COMMISSION As String
Global SALES_ANALYSIS_COL_MONTHLY_MARGIN As String
Global SALES_ANALYSIS_COL_QUATERLY_MARGIN As String
Global SALES_ANALYSIS_COL_QUATERLY_COMMISSION_ As String
'row
Global SALES_ANALYSIS_ROW_JANUARY As String
Global SALES_ANALYSIS_ROW_FEBURARY As String
Global SALES_ANALYSIS_ROW_MARCH As String
Global SALES_ANALYSIS_ROW_APRIL As String
Global SALES_ANALYSIS_ROW_MAY As String
Global SALES_ANALYSIS_ROW_JUNE As String
Global SALES_ANALYSIS_ROW_JULY As String
Global SALES_ANALYSIS_ROW_AUGEST As String
Global SALES_ANALYSIS_ROW_SEPTEMBER As String
Global SALES_ANALYSIS_ROW_OCTOBER As String
Global SALES_ANALYSIS_ROW_NOVEMBER As String
Global SALES_ANALYSIS_ROW_DECEMBER As String
Global SALES_ARRAY As Variant
Global monthly_commission_per_agent As Object
Global STRING_SEPERATOR As String
' Global YEAR_GRAPHS_TOP as variant
' Global YEAR_GRAPHS_LEFT as variant
Global MONTH_NAMES As Variant
Sub init()
STRING_SEPERATOR = "#_STRING_SEPERATOR_#"
SALES_ANALYSIS_COL_MONTH = "A"
SALES_ANALYSIS_COL_QUARTER = "B"
SALES_ANALYSIS_COL_PRODUCT_CATEGORY = "C"
SALES_ANALYSIS_COL_SELLING_UNIT = "D"
SALES_ANALYSIS_COL_MONTHLY_SALES = "E"
SALES_ANALYSIS_COL_QUARTELY_SALES = "F"
SALES_ANALYSIS_COL_COMMISSION = "G"
SALES_ANALYSIS_COL_MONTHLY_MARGIN = "H"
SALES_ANALYSIS_COL_QUATERLY_MARGIN = "I"
SALES_ANALYSIS_COL_QUATERLY_COMMISSION_ = "J"
'row
SALES_ANALYSIS_ROW_JANUARY = "2"
SALES_ANALYSIS_ROW_FEBURARY = "3"
SALES_ANALYSIS_ROW_MARCH = "4"
SALES_ANALYSIS_ROW_APRIL = "5"
SALES_ANALYSIS_ROW_MAY = "6"
SALES_ANALYSIS_ROW_JUNE = "7"
SALES_ANALYSIS_ROW_JULY = "8"
SALES_ANALYSIS_ROW_AUGEST = "9"
SALES_ANALYSIS_ROW_SEPTEMBER = "10"
SALES_ANALYSIS_ROW_OCTOBER = "11"
SALES_ANALYSIS_ROW_NOVEMBER = "12"
SALES_ANALYSIS_ROW_DECEMBER = "13"
NumOfSales = 20
SALES_ARRAY = Array("Alex", "Ben", "Candy", "Danny", "Eason", "Filex", "Gary", "Henry", "Irene", "Jenny")
Dim top_comission(12, 3) As Double
Set monthly_commission_per_agent = CreateObject("Scripting.Dictionary")
MONTH_NAMES = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
End Sub

View File

@@ -0,0 +1,311 @@
Attribute VB_Name = "NoOfCasesTable"
Global new_case_per_agent As Object
Global collapsed_case_per_agent As Object
Global new_case_team_a As Double
Global collapsed_case_team_a As Double
Global new_case_team_b As Double
Global collapsed_case_team_b As Double
Global case_persistency_by_agent As Object
' Global case_persistency_team_a As Double
' Global case_persistency_team_b As Double
Function NoOfCasesTable_Calc(ByVal TablesMeta As Variant) As Variant
Debug.Print "helloworld"
Set new_case_per_agent = CreateObject("Scripting.Dictionary")
Set collapsed_case_per_agent = CreateObject("Scripting.Dictionary")
Set case_persistency_by_agent = CreateObject("Scripting.Dictionary")
Dim case_persistency_team_a As Double
Dim case_persistency_team_b As Double
'case_team_a_meta
Dim case_team_a_meta As Variant
Dim case_team_b_meta As Variant
Dim agent_sales_table As Variant
Dim product_sales_meta As Variant
Dim product_sales_table As Variant
Dim val_agent_name As String
Dim val_team As String
agent_sales_table = TablesMeta(0)
Dim agent_sales_table_rows As Variant
agent_sales_table_rows = agent_sales_table(0)
product_sales_table = TablesMeta(1)
Dim product_sales_table_row As Variant
product_sales_table_row = product_sales_table(0)
agent_working_performance_table = TablesMeta(2)
Dim agent_working_performance_table_rows As Variant
agent_working_performance_table_rows = agent_working_performance_table(0)
Dim val_product_sales_selling_unit As String
Dim sales_selling_unit_TA As Integer
Dim sales_selling_unit_TB As Integer
Dim team As String
For ps = 1 To agent_working_performance_table(1)
val_agent_name = agent_working_performance_table_rows(ps, 2)
val_team = agent_working_performance_table_rows(ps, 3)
num_new_case = agent_working_performance_table_rows(ps, 4)
num_collapsed_case = agent_working_performance_table_rows(ps, 5)
If (Not (IsEmpty(val_agent_name)) And Not (new_case_per_agent.exists(val_agent_name))) Then
new_case_per_agent(val_agent_name) = 0
End If
new_case_per_agent(val_agent_name) = new_case_per_agent(val_agent_name) + num_new_case
If (Not (IsEmpty(val_agent_name)) And Not (collapsed_case_per_agent.exists(val_agent_name))) Then
collapsed_case_per_agent(val_agent_name) = 0
End If
collapsed_case_per_agent(val_agent_name) = collapsed_case_per_agent(val_agent_name) + num_collapsed_case
If (val_team = "A") Then
new_case_team_a = new_case_team_a + num_new_case
collapsed_case_team_a = collapsed_case_team_a + num_collapsed_case
End If
If (val_team = "B") Then
new_case_team_b = new_case_team_b + num_new_case
collapsed_case_team_b = collapsed_case_team_b + num_collapsed_case
End If
Next ps
For s = 0 To UBound(SALES_ARRAY)
sales_name = SALES_ARRAY(s)
collapsed_case = collapsed_case_per_agent(sales_name)
new_case = new_case_per_agent(sales_name)
case_persistency_by_agent(sales_name) = (new_case - collapsed_case) / new_case
Next s
case_persistency_team_a = (new_case_team_a - collapsed_case_team_a) / new_case_team_a
case_persistency_team_b = (new_case_team_b - collapsed_case_team_b) / new_case_team_b
case_team_a_meta = Array(new_case_team_a, collapsed_case_team_a)
case_team_b_meta = Array(new_case_team_b, collapsed_case_team_b)
NoOfCasesTable_Calc = Array(1, sales_selling_unit_TA, sales_selling_unit_TB, case_persistency_team_a, case_persistency_team_b, case_team_a_meta, case_team_b_meta)
End Function
Function NoOfCasesTable_WriteTable(ByVal calc_result As Variant, ByVal FILE_PATH As String)
Dim sales_selling_unit_TA As Integer
Dim sales_selling_unit_TB As Integer
sales_selling_unit_TA = calc_result(1)
sales_selling_unit_TB = calc_result(2)
Dim case_persistency_team_a As Double
Dim case_persistency_team_b As Double
case_persistency_team_a = calc_result(3)
case_persistency_team_b = calc_result(4)
Const TOP_ROW As Long = 1
Dim wb As Workbook
Dim ws As Worksheet
Dim startCell As Range
Dim tempArray() As Variant
Dim i As Long
' Open the workbook
Set wb = Workbooks.Open(FILE_PATH)
' Check if the sheet exists
On Error Resume Next
Set ws = wb.Sheets("No. of cases")
On Error GoTo 0
' If not found, create a new sheet
If ws Is Nothing Then
Set ws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
ws.Name = "No. of cases"
Else
' Empty the entire sheet
ws.UsedRange.ClearContents
End If
' Write month names
Set startCell = ws.Range("A1")
tempArray = Array("Case Persistency")
For i = LBound(tempArray) To UBound(tempArray)
startCell.Offset(0, i).Value = tempArray(i)
Next i
' Write month names
Set startCell = ws.Range("A2")
tempArray = Array("Name", "No of new case", "No. of collpased case", "Case Persistency")
For i = LBound(tempArray) To UBound(tempArray)
startCell.Offset(0, i).Value = tempArray(i)
Next i
' Write month names
Set startCell = ws.Range("A3")
For i = LBound(SALES_ARRAY) To UBound(SALES_ARRAY)
startCell.Offset(i, 0).Value = SALES_ARRAY(i)
Next i
' Write month names
Set startCell = ws.Range("B3")
' For sales_name = LBound(SALES_ARRAY) To UBound(SALES_ARRAY)
For s = 0 To UBound(SALES_ARRAY)
sales_name = SALES_ARRAY(s)
startCell.Offset(s, 0).Value = new_case_per_agent(sales_name)
Next s
' Write month names
Set startCell = ws.Range("C3")
' For sales_name = LBound(SALES_ARRAY) To UBound(SALES_ARRAY)
For s = 0 To UBound(SALES_ARRAY)
sales_name = SALES_ARRAY(s)
startCell.Offset(s, 0).Value = collapsed_case_per_agent(sales_name)
Next s
' Write month names
Set startCell = ws.Range("D3")
' For sales_name = LBound(SALES_ARRAY) To UBound(SALES_ARRAY)
For s = 0 To UBound(SALES_ARRAY)
sales_name = SALES_ARRAY(s)
startCell.Offset(s, 0).Value = case_persistency_by_agent(sales_name)
startCell.Offset(s, 0).NumberFormat = "0.00%"
Next s
' Write month names
Set startCell = ws.Range("A14")
tempArray = Array("Team A total", "Team B Total")
For i = LBound(tempArray) To UBound(tempArray)
startCell.Offset(i, 0).Value = tempArray(i)
Next i
' Write month names
Set startCell = ws.Range("B14")
tempArray = Array("Team A total", "Team B Total")
startCell.Offset(0, 0).Value = new_case_team_a
startCell.Offset(1, 0).Value = new_case_team_b
' Write month names
Set startCell = ws.Range("C14")
tempArray = Array("Team A total", "Team B Total")
startCell.Offset(0, 0).Value = collapsed_case_team_a
startCell.Offset(1, 0).Value = collapsed_case_team_b
' Write month names
Set startCell = ws.Range("D14")
tempArray = Array("Team A total", "Team B Total")
startCell.Offset(0, 0).Value = case_persistency_team_a
startCell.Offset(1, 0).Value = case_persistency_team_b
startCell.Offset(0, 0).NumberFormat = "0.00%"
startCell.Offset(1, 0).NumberFormat = "0.00%"
' styling
Dim ranges_need_paint As Variant
For i = 0 To 100
ws.Range("A1").Offset(0, i).EntireColumn.AutoFit
Next i
For i = 0 To 3
Range("A1").Offset(0, i).EntireColumn.ColumnWidth = 20
Next i
ranges_need_paint = Array("A1")
For r = LBound(ranges_need_paint) To UBound(ranges_need_paint)
range_need_merge = ranges_need_paint(r)
With Range(range_need_merge)
.Interior.Color = RGB(68, 114, 196)
.Font.Color = RGB(255, 255, 255)
End With
Next r
ranges_need_paint = Array("A2")
For r = LBound(ranges_need_paint) To UBound(ranges_need_paint)
range_need_merge = ranges_need_paint(r)
With Range(range_need_merge)
.Font.Color = RGB(48, 84, 150)
End With
Next r
ranges_need_paint = Array("B2:C2")
For r = LBound(ranges_need_paint) To UBound(ranges_need_paint)
range_need_merge = ranges_need_paint(r)
With Range(range_need_merge)
.Font.Color = RGB(48, 84, 150)
.Font.Bold = True
End With
Next r
ranges_need_paint = Array("D2")
For r = LBound(ranges_need_paint) To UBound(ranges_need_paint)
range_need_merge = ranges_need_paint(r)
With Range(range_need_merge)
.Font.Color = RGB(0, 0, 0)
.Font.Bold = True
End With
Next r
ranges_need_paint = Array("A3:D3", "A5:D5", "A7:D7", "A9:D9", "A11:D11", "A13:D13", "A15:D15")
For r = LBound(ranges_need_paint) To UBound(ranges_need_paint)
range_need_merge = ranges_need_paint(r)
With Range(range_need_merge)
.Interior.Color = RGB(217, 225, 242)
End With
Next r
With Range("B2:D15")
.VerticalAlignment = xlVAlignCenter
.HorizontalAlignment = xlHAlignCenter
End With
For Each r In Array("A2:D2", "A3:D15")
With Range(r).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Range(r).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Range(r).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Range(r).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Next r
End Function

View File

@@ -0,0 +1,78 @@
Attribute VB_Name = "ReadAgentSalesWorkbook"
Function Run(ByRef sPath As String) As Variant
Dim wb As Workbook
Dim arrResults(999, 20) As Variant
Dim row() As Variant
Dim i As Integer
Dim row_count As Integer
Dim firstRow As Boolean
Dim rw As Range
' Try to open the workbook
On Error Resume Next
Set wb = Workbooks.Open(sPath)
On Error GoTo 0
' Check if the opening was successful
If wb Is Nothing Then
MsgBox "Could not open workbook at " & sPath, vbCritical, "Error"
Exit Function
End If
row_count = 0
If Not wb.Sheets("Sheet1") Is Nothing Then
' Read data from Sheet1
For Each rw In wb.Sheets("Sheet1").UsedRange.Rows
' Check if first cell is empty
If Trim(rw.Cells(1)) <> "" Then
' Print value of first column of current row to immediate window
row_count = row_count + 1
Else
' First cell in current row is empty, so break the loop
Exit For
End If
Next rw
End If
' read table content
i = 1
firstRow = True
' Look for Sheet1 and stop execution if it doesn't exist
If Not wb.Sheets("Sheet1") Is Nothing Then
' Read data from Sheet1
For Each rw In wb.Sheets("Sheet1").UsedRange.Rows
' Check if first cell is empty
If (firstRow = False) Then
If (Trim(rw.Cells(1)) <> "") Then
' Print value of first column of current row to immediate window
arrResults(i, 1) = rw.Cells(1).Value
arrResults(i, 2) = rw.Cells(2).Value
arrResults(i, 3) = rw.Cells(3).Value
arrResults(i, 4) = rw.Cells(4).Value
arrResults(i, 5) = rw.Cells(5).Value
arrResults(i, 6) = rw.Cells(6).Value
i = i + 1
Else
' First cell in current row is empty, so break the loop
Exit For
End If
End If
firstRow = False
Next rw
Else
MsgBox """Sheet1"" does not exist in workbook at " & sPath, vbExclamation, "Warning"
Exit Function
End If
wb.Close SaveChanges:=False
Run = Array(arrResults, row_count - 1)
End Function

View File

@@ -0,0 +1,82 @@
Attribute VB_Name = "ReadAgentWorkingPerfWorkbook"
Function Run(ByRef sPath As String) As Variant
Dim wb As Workbook
Dim arrResults(999, 20) As Variant
Dim row() As Variant
Dim i As Integer
Dim row_count As Integer
Dim firstRow As Boolean
Dim rw As Range
' Try to open the workbook
On Error Resume Next
Set wb = Workbooks.Open(sPath)
On Error GoTo 0
' Check if the opening was successful
If wb Is Nothing Then
MsgBox "Could not open workbook at " & sPath, vbCritical, "Error"
Exit Function
End If
row_count = 0
If Not wb.Sheets("Sheet1") Is Nothing Then
' Read data from Sheet1
For Each rw In wb.Sheets("Sheet1").UsedRange.Rows
' Check if first cell is empty
If Trim(rw.Cells(1)) <> "" Then
' Print value of first column of current row to immediate window
row_count = row_count + 1
Else
' First cell in current row is empty, so break the loop
Exit For
End If
Next rw
End If
' read table content
i = 1
firstRow = True
' Look for Sheet1 and stop execution if it doesn't exist
If Not wb.Sheets("Sheet1") Is Nothing Then
' Read data from Sheet1
For Each rw In wb.Sheets("Sheet1").UsedRange.Rows
' Check if first cell is empty
If (firstRow = False) Then
If (Trim(rw.Cells(1)) <> "") Then
' Print value of first column of current row to immediate window
arrResults(i, 1) = rw.Cells(1).Value
arrResults(i, 2) = rw.Cells(2).Value
arrResults(i, 3) = rw.Cells(3).Value
arrResults(i, 4) = rw.Cells(4).Value
arrResults(i, 5) = rw.Cells(5).Value
arrResults(i, 6) = rw.Cells(6).Value
i = i + 1
Else
' First cell in current row is empty, so break the loop
Exit For
End If
End If
firstRow = False
Next rw
Else
MsgBox """Sheet1"" does not exist in workbook at " & sPath, vbExclamation, "Warning"
Exit Function
End If
Debug.Print arrResults(150, 2)
wb.Close SaveChanges:=False
Run = Array(arrResults, row_count - 1)
End Function

View File

@@ -0,0 +1,79 @@
Attribute VB_Name = "ReadProductSalesWorkbook"
Function Run(ByRef sPath As String) As Variant
Dim wb As Workbook
Dim arrResults(999, 20) As Variant
Dim row() As Variant
Dim i As Integer
Dim row_count As Integer
Dim firstRow As Boolean
Dim rw As Range
' Try to open the workbook
On Error Resume Next
Set wb = Workbooks.Open(sPath)
On Error GoTo 0
' Check if the opening was successful
If wb Is Nothing Then
MsgBox "Could not open workbook at " & sPath, vbCritical, "Error"
Exit Function
End If
row_count = 0
If Not wb.Sheets("Sheet1") Is Nothing Then
' Read data from Sheet1
For Each rw In wb.Sheets("Sheet1").UsedRange.Rows
' Check if first cell is empty
If Trim(rw.Cells(1)) <> "" Then
' Print value of first column of current row to immediate window
row_count = row_count + 1
Else
' First cell in current row is empty, so break the loop
Exit For
End If
Next rw
End If
' read table content
i = 1
firstRow = True
' Look for Sheet1 and stop execution if it doesn't exist
If Not wb.Sheets("Sheet1") Is Nothing Then
' Read data from Sheet1
For Each rw In wb.Sheets("Sheet1").UsedRange.Rows
' Check if first cell is empty
If (firstRow = False) Then
If (Trim(rw.Cells(1)) <> "") Then
' Print value of first column of current row to immediate window
arrResults(i, 1) = rw.Cells(1).Value
arrResults(i, 2) = rw.Cells(2).Value
arrResults(i, 3) = rw.Cells(3).Value
arrResults(i, 4) = rw.Cells(4).Value
arrResults(i, 5) = rw.Cells(5).Value
arrResults(i, 6) = rw.Cells(6).Value
i = i + 1
Else
' First cell in current row is empty, so break the loop
Exit For
End If
End If
firstRow = False
Next rw
Else
MsgBox """Sheet1"" does not exist in workbook at " & sPath, vbExclamation, "Warning"
Exit Function
End If
Debug.Print arrResults(150, 1)
wb.Close
Run = Array(arrResults, row_count - 1)
End Function

View File

@@ -0,0 +1,321 @@
Attribute VB_Name = "SAMonthAndQuart"
Function CalcSalesAnalysisMonthlyAndQuart(ByVal TablesMeta As Variant) As Variant
Dim quarter(4) As Double
Dim quaterly_margin(4) As Double
Dim quaterly_comission(4) As Double
Dim quaterly_sales(4) As Double
Dim calc_monthly_product_category(12) As String
Dim monthly_product_category(12) As String
Dim monthly_selling_unit(12) As Double
Dim monthly_sales(12) As Double
Dim monthly_margin(12) As Double
Dim monthly_commission(12) As Double
' Dim monthly_commission_per_agent(999, 2) As String
Dim comission_array_for_sorting(999) As Double
Dim monthly_commission_per_agent
Set monthly_commission_per_agent = CreateObject("Scripting.Dictionary")
Dim sales_agent_names
Set sales_agent_names = CreateObject("Scripting.Dictionary")
Dim val_agent_sale_sales_num As String
Dim val_agent_sale_date As String
Dim val_agent_sale_agent_name As String
Dim val_agent_sale_team As String
Dim val_agent_sale_selling_price As String
Dim val_agent_sale_commision_pct As String
Dim val_product_sales_sales_num As String
Dim val_product_sales_date As String
Dim val_product_sales_product_category As String
Dim val_product_sales_selling_unit As String
Dim val_product_sales_selling_price As String
Dim val_product_sales_comission As String
Dim val_product_sales_total_comission As String
' product sales calculation
Dim val_product_sales_margin As Double
Dim dt As Date
Dim intMonth As Integer
Dim intQuarter As Integer
Dim agent_sales_table As Variant
Dim product_sales_table As Variant
Dim agent_working_performance As Variant
agent_sales_table = TablesMeta(0)
product_sales_table = TablesMeta(1)
agent_working_performance = TablesMeta(2)
Dim agent_sales_table_row As Variant
agent_sales_table_rows = agent_sales_table(0)
Dim product_sales_table_row As Variant
product_sales_table_row = product_sales_table(0)
Dim agent_working_performance_row As Variant
agent_working_performance_row = agent_working_performance(0)
Dim top_comission(12, 3) As Double
For i = 1 To agent_sales_table(1)
val_agent_sale_date = agent_sales_table_rows(i, 2)
dt = DateValue(val_agent_sale_date)
intMonth = month(dt)
intQuarter = Int((intMonth - 1) / 3) + 1
val_agent_sale_sales_num = agent_sales_table_rows(i, 1)
val_agent_sale_agent_name = agent_sales_table_rows(i, 3)
val_agent_sale_team = agent_sales_table_rows(i, 4)
val_agent_sale_selling_price = agent_sales_table_rows(i, 5)
val_agent_sale_commision_pct = agent_sales_table_rows(i, 6)
Next i
For ps = 1 To product_sales_table(1)
val_product_sales_date = product_sales_table_row(ps, 2)
dt = DateValue(val_product_sales_date)
intMonth = month(dt)
intQuarter = Int((intMonth - 1) / 3) + 1
val_agent_sale_agent_name = agent_sales_table_rows(ps, 3)
val_product_sales_sales_num = product_sales_table_row(ps, 1)
val_product_sales_product_category = product_sales_table_row(ps, 3)
val_product_sales_selling_unit = product_sales_table_row(ps, 4)
val_product_sales_selling_price = product_sales_table_row(ps, 5)
val_agent_sale_commision_pct = agent_sales_table_rows(ps, 6)
' val_product_sales_total_comission = product_sales_table_row(i, 7)
If InStr(calc_monthly_product_category(intMonth), val_product_sales_product_category) < 1 Then
calc_monthly_product_category(intMonth) = calc_monthly_product_category(intMonth) + STRING_SEPERATOR + val_product_sales_product_category
End If
'calculate comission
val_product_sales_comission = val_product_sales_selling_unit * val_product_sales_selling_price * val_agent_sale_commision_pct
product_sales_table_row(ps, 6) = val_product_sales_comission
' calc margin
val_product_sales_margin = val_product_sales_selling_price - val_product_sales_comission
product_sales_table_row(ps, 7) = val_product_sales_margin
'monthly calculation
monthly_selling_unit(intMonth) = monthly_selling_unit(intMonth) + val_product_sales_selling_unit
monthly_sales(intMonth) = monthly_sales(intMonth) + val_product_sales_selling_price
monthly_commission(intMonth) = monthly_commission(intMonth) + val_product_sales_comission
monthly_margin(intMonth) = monthly_margin(intMonth) + val_product_sales_margin
'quartely calculation
quaterly_sales(intQuarter) = quaterly_sales(intQuarter) + val_product_sales_comission
quaterly_margin(intQuarter) = quaterly_margin(intQuarter) + val_product_sales_margin
quaterly_comission(intQuarter) = quaterly_comission(intQuarter) + val_product_sales_comission
Next ps
' get monthly sales by agent
For ps = 1 To product_sales_table(1)
Dim temp_key As String
temp_key = val_agent_sale_agent_name + "," + CStr(intMonth)
If (Not (IsEmpty(temp_key)) And Not (monthly_commission_per_agent.exists(temp_key))) Then
For j = 1 To 12
monthly_commission_per_agent(val_agent_sale_agent_name + "," + CStr(j)) = 0
Next j
End If
monthly_commission_per_agent(temp_key) = monthly_commission_per_agent(temp_key) + val_product_sales_comission
Next ps
' get first 3 per comission per month
For m = 1 To 12
Dim temp_sort(20) As Double
j = 0
For Each agent_name_and_month In monthly_commission_per_agent.Keys
If (Split(agent_name_and_month, ",")(1) = CStr(m)) Then
temp_sort(j) = monthly_commission_per_agent(agent_name_and_month)
j = j + 1
End If
Next agent_name_and_month
sortedArray = SortArray(temp_sort)
top_comission(m, 0) = sortedArray(0)
top_comission(m, 1) = sortedArray(1)
top_comission(m, 2) = sortedArray(2)
' total comission
product_sales_table_row(m, 7) = product_sales_table_row(m, 6) + bonus
Next m
For m = 1 To 12
Dim temp() As String
temp = Split(calc_monthly_product_category(m), STRING_SEPERATOR)
monthly_product_category(m) = CStr(UBound(temp)) + "(" + Join(temp, ",") + ")"
Next m
'get the total commission with bonus
CalcSalesAnalysisMonthlyAndQuart = Array(monthly_product_category, monthly_selling_unit, monthly_sales, quaterly_sales, monthly_commission, monthly_margin, quaterly_margin, quaterly_comission)
End Function
Function WriteSalesAnalysisMonthlyAndQuart(ByVal calc_result As Variant, ByVal FILE_PATH As String)
' monthly_product_category,
' monthly_selling_unit,
' monthly_sales,
' quaterly_sales,
' monthly_commission,
' monthly_margin,
' quaterly_margin,
' quaterly_comission
Application.DisplayAlerts = False
Const HEADER_ROW As Long = 1
Const START_CELL As String = "A2"
Dim wb As Workbook
Dim ws As Worksheet
Dim startCell As Range
' Open the workbook
Set wb = Workbooks.Open(FILE_PATH)
' Check if the sheet exists
On Error Resume Next
Set ws = wb.Sheets("Sales Analysis Monthly & Quart")
On Error GoTo 0
' If not found, create a new sheet
If ws Is Nothing Then
Set ws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
ws.Name = "Sales Analysis Monthly & Quart"
Else
' Empty the entire sheet
ws.UsedRange.ClearContents
End If
' Write headers
With ws.Rows(HEADER_ROW)
.Cells(1).Value = "Month"
.Cells(2).Value = "Quarter"
.Cells(3).Value = "Product Category"
.Cells(4).Value = "Selling Unit"
.Cells(5).Value = "Monthly Sales"
.Cells(6).Value = "Quartely Sales"
.Cells(7).Value = "Commission"
.Cells(8).Value = "Monthly Margin"
.Cells(9).Value = "Quaterly Margin"
.Cells(10).Value = "Quaterly Commission"
End With
' Write month names
Set startCell = ws.Range("A2")
Dim monthNames() As Variant
monthNames = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
Dim monthly_product_category As Variant
monthly_product_category = calc_result(0)
monthly_selling_unit = calc_result(1)
monthly_sales = calc_result(2)
quaterly_sales = calc_result(3)
monthly_commission = calc_result(4)
monthly_margin = calc_result(5)
quaterly_margin = calc_result(6)
quaterly_comission = calc_result(7)
'output content
For m = LBound(monthNames) To UBound(monthNames)
Dim quarter, month As Integer
month = m + 1
quarter = GetQuarterFromMonth(month)
startCell.Offset(m, 0).Value = monthNames(m)
startCell.Offset(m, 1).Value = monthly_product_category(month)
startCell.Offset(m, 2).Value = monthly_selling_unit(month)
startCell.Offset(m, 3).Value = monthly_sales(month)
startCell.Offset(m, 4).Value = monthly_sales(month)
startCell.Offset(m, 5).Value = quaterly_sales(quarter)
startCell.Offset(m, 6).Value = monthly_commission(month)
startCell.Offset(m, 7).Value = monthly_margin(month)
startCell.Offset(m, 8).Value = quaterly_margin(quarter)
startCell.Offset(m, 9).Value = quaterly_comission(quarter)
Next m
Range("A1:J1").Interior.Color = RGB(252, 229, 205)
Dim column_used As Variant
column_used = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
For c = LBound(column_used) To UBound(column_used)
Columns(column_used(c)).EntireColumn.AutoFit
Next c
'rgb(255, 242, 204)
Range("A5:J7").Interior.Color = RGB(255, 242, 204)
Range("A11:J13").Interior.Color = RGB(255, 242, 204)
Dim columns_need_merge As Variant
columns_need_merge = Array("F", "I", "J")
For c = LBound(columns_need_merge) To UBound(columns_need_merge)
Dim column As String
column = columns_need_merge(c)
With Range(column & "2:" & column & "4")
.Merge ' merges cells F5, F6, and F7 into a single cell
.VerticalAlignment = xlVAlignCenter ' centering the text vertically within the merged cell
.HorizontalAlignment = xlHAlignRight ' centering the text horizontally across the merged cell
End With
With Range(column & "5:" & column & "7")
.Merge ' merges cells F5, F6, and F7 into a single cell
.VerticalAlignment = xlVAlignCenter ' centering the text vertically within the merged cell
.HorizontalAlignment = xlHAlignRight ' centering the text horizontally across the merged cell
End With
With Range(column & "8:" & column & "10")
.Merge ' merges cells F5, F6, and F7 into a single cell
.VerticalAlignment = xlVAlignCenter ' centering the text vertically within the merged cell
.HorizontalAlignment = xlHAlignRight ' centering the text horizontally across the merged cell
End With
With Range(column & "11:" & column & "13")
.Merge ' merges cells F5, F6, and F7 into a single cell
.VerticalAlignment = xlVAlignCenter ' centering the text vertically within the merged cell
.HorizontalAlignment = xlHAlignRight ' centering the text horizontally across the merged cell
End With
Next c
' Save and close the workbook
' wb.Close SaveChanges:=True
End Function

View File

@@ -0,0 +1,177 @@
Attribute VB_Name = "SAMonthAndQuartGraph"
Function MonthlySalesAmountTable(ByVal calc_result As Variant, ByVal FILE_PATH As String)
' monthly_product_category,
' monthly_selling_unit,
' monthly_sales,
' quaterly_sales,
' monthly_commission,
' monthly_margin,
' quaterly_margin,
' quaterly_comission
Const HEADER_ROW As Long = 1
Const START_CELL As String = "A1"
Dim wb As Workbook
Dim ws As Worksheet
Dim startCell As Range
' Open the workbook
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Sales Analysis Monthly_Quartery")
' Write headers
Set startCell = ws.Range(START_CELL)
With startCell
.Value = "Monthly Sales Amount in 2023"
End With
With startCell
.Offset(1, 0).Value = "date"
.Offset(1, 1).Value = "Monthly Sales"
End With
Set startCell = ws.Range("A3")
Dim monthNames() As Variant
monthNames = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
monthly_sales = calc_result(2)
For m = LBound(monthNames) To UBound(monthNames)
startCell.Offset(m, 0).Value = monthNames(m)
startCell.Offset(m, 1).Value = monthly_sales(m + 1)
Next m
' TODO: replace content to real data
' Save and close the workbook
' wb.Close SaveChanges:=True
End Function
Function MonthlySalesAmountGraph(ByVal FILE_PATH As String)
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Sales Analysis Monthly_Quartery")
Range("A2:B14").Select
ActiveSheet.Shapes.AddChart2(332, xlLineMarkers).Select
ActiveChart.SetSourceData Source:=Range("$A$2:$B$14")
ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
Selection.Format.TextFrame2.TextRange.Characters.Text = "Date range"
Set cho = ws.ChartObjects(1)
Set cht = cho.Chart
cht.SetElement (msoElementPrimaryValueAxisTitleAdjacentToAxis)
'# set your axis in a variable
Set ax = cht.Axes(xlValue, xlPrimary)
'# Make sure your axis HAS a title
ax.HasTitle = True
With ax.AxisTitle.Format.TextFrame2.TextRange
.Characters.Text = "Primary Y-Axis"
With .Characters(1, 14).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
End With
cho.Top = 0
cho.Left = 0
cho.Width = 400
cho.Height = 300
End Function
Function MonthlySalesComissionTable(ByVal calc_result As Variant, ByVal FILE_PATH As String)
Const HEADER_ROW As Long = 1
Const START_CELL As String = "F1"
Dim wb As Workbook
Dim ws As Worksheet
Dim startCell As Range
' Open the workbook
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Sales Analysis Monthly_Quartery")
' Write headers
Set startCell = ws.Range(START_CELL)
With startCell
.Value = "Monthly Sales Comission in 2023"
End With
With startCell
.Offset(1, 0).Value = "date"
.Offset(1, 1).Value = "Monthly Sales Commission"
End With
Set startCell = ws.Range("F3")
Dim monthNames() As Variant
monthNames = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
monthly_commission = calc_result(4)
For m = LBound(monthNames) To UBound(monthNames)
startCell.Offset(m, 0).Value = monthNames(m)
startCell.Offset(m, 1).Value = monthly_commission(m + 1)
Next m
' TODO: replace content to real data
' Save and close the workbook
' wb.Close SaveChanges:=True
End Function
Function MonthlySalesComissionGraph(ByVal FILE_PATH As String)
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Sales Analysis Monthly_Quartery")
ActiveSheet.Shapes.AddChart2(332, xlLineMarkers).Select
ActiveChart.SetSourceData Source:=Range("$F$2:$G$14")
ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
Selection.Format.TextFrame2.TextRange.Characters.Text = "Date range chart2"
Set cho = ws.ChartObjects(2)
Set cht = cho.Chart
cht.SetElement (msoElementPrimaryValueAxisTitleAdjacentToAxis)
'# set your axis in a variable
Set ax = cht.Axes(xlValue, xlPrimary)
'# Make sure your axis HAS a title
ax.HasTitle = True
With ax.AxisTitle.Format.TextFrame2.TextRange
.Characters.Text = "Primary Y-Axis"
With .Characters(1, 14).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
End With
cho.Top = 0
cho.Left = 400
cho.Width = 400
cho.Height = 300
End Function
Function Helloworld()
Debug.Print "helloworld SalesAnalysisMonthAndQuartGraph"
End Function

View File

@@ -0,0 +1,233 @@
Attribute VB_Name = "SAProdCatGraph"
Function SalesAmountTable(ByVal calc_result As Variant, ByVal FILE_PATH As String, ByVal int_month As Integer)
Const START_CELL As String = "A1"
Dim wb As Workbook
Dim ws As Worksheet
Dim startCell As Range
Dim row As Integer
Dim TravelInsuranceByMonth As Variant
Dim HealthInsuranceByMonth As Variant
Dim LifeInsuranceByMonth As Variant
Dim VehicleInsuranceByMonth As Variant
Dim AccidentInsuranceByMonth As Variant
TravelInsuranceByMonth = calc_result(0)
HealthInsuranceByMonth = calc_result(1)
LifeInsuranceByMonth = calc_result(2)
VehicleInsuranceByMonth = calc_result(3)
AccidentInsuranceByMonth = calc_result(4)
' Open the workbook
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Sales Analysis Product Category")
Dim InstType() As Variant
InstType = Array("Accident insurance", "Vehicle insurance", "Life insurance", "Health insurance", "Travel insurance")
' Write headers
Set startCell = ws.Range(START_CELL)
For m = LBound(MONTH_NAMES) To UBound(MONTH_NAMES)
month_name = MONTH_NAMES(m)
row = 0
startCell.Offset(row, 0 + (m * 3)).Value = "Sales unit of " & month_name
row = row + 1
startCell.Offset(row, 0 + (m * 3)).Value = "Type"
startCell.Offset(row, 1 + (m * 3)).Value = "Sales"
row = row + 1
startCell.Offset(row, 0 + (m * 3)).Value = "Accident insurance"
startCell.Offset(row, 1 + (m * 3)).Value = AccidentInsuranceByMonth(m + 1)
row = row + 1
startCell.Offset(row, 0 + (m * 3)).Value = "Vehicle insurance"
startCell.Offset(row, 1 + (m * 3)).Value = VehicleInsuranceByMonth(m + 1)
row = row + 1
startCell.Offset(row, 0 + (m * 3)).Value = "Life insurance"
startCell.Offset(row, 1 + (m * 3)).Value = LifeInsuranceByMonth(m + 1)
row = row + 1
startCell.Offset(row, 0 + (m * 3)).Value = "Health insurance"
startCell.Offset(row, 1 + (m * 3)).Value = HealthInsuranceByMonth(m + 1)
row = row + 1
startCell.Offset(row, 0 + (m * 3)).Value = "Travel insurance"
startCell.Offset(row, 1 + (m * 3)).Value = TravelInsuranceByMonth(m + 1)
Next m
' TODO: replace content to real data
' Save and close the workbook
' wb.Close SaveChanges:=True
End Function
Function SalesAmountGraph(ByVal calc_result As Variant, ByVal FILE_PATH As String, ByVal int_month As Integer)
Dim wb As Workbook
Dim ws As Worksheet
Dim YEAR_GRAPHS_TOP As Variant
Dim YEAR_GRAPHS_LEFT As Variant
YEAR_GRAPHS_TOP = Array(0, 0, 0, 300, 300, 300, 600, 600, 600, 900, 900, 900)
YEAR_GRAPHS_LEFT = Array(0, 400, 800, 0, 400, 800, 0, 400, 800, 0, 400, 800)
Dim DATA_RANGES As Variant
DATA_RANGES = Array("A2:B7", "D2:E7", "G2:H7", "J2:K7", "M2:N7", "P2:Q7", "S2:T7", "V2:W7", "Y2:Z7", "AB2:AC7", "AE2:AF7", "AH2:AI7")
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Sales Analysis Product Category")
For m = LBound(MONTH_NAMES) To UBound(MONTH_NAMES)
month_name = MONTH_NAMES(m)
data_range = DATA_RANGES(m)
ActiveSheet.Shapes.AddChart2(251, xlPie).Select
ActiveChart.SetSourceData Source:=Range(data_range)
ActiveChart.SetElement (msoElementLegendNone)
ActiveChart.SetElement (msoElementDataLabelCallout)
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = "Sales amount of " & month_name
Selection.Format.TextFrame2.TextRange.Characters.Text = "Sales amount of " & month_name
Set cho = ws.ChartObjects(ws.ChartObjects.Count)
Set cht = cho.Chart
cho.Top = YEAR_GRAPHS_TOP(m)
cho.Left = YEAR_GRAPHS_LEFT(m)
cho.Width = 400
cho.Height = 300
Next m
End Function
Function SalesUnitTable(ByVal calc_result As Variant, ByVal FILE_PATH As String, ByVal int_month As Integer)
' Const HEADER_ROW As Long = 1
' Const START_CELL As String = "F1"
' Dim wb As Workbook
' Dim ws As Worksheet
' Dim startCell As Range
Const START_CELL As String = "A10"
Dim wb As Workbook
Dim ws As Worksheet
Dim startCell As Range
Dim row As Integer
Dim TravelInsuranceByMonth As Variant
Dim HealthInsuranceByMonth As Variant
Dim LifeInsuranceByMonth As Variant
Dim VehicleInsuranceByMonth As Variant
Dim AccidentInsuranceByMonth As Variant
TravelInsuranceByMonth = calc_result(0)
HealthInsuranceByMonth = calc_result(1)
LifeInsuranceByMonth = calc_result(2)
VehicleInsuranceByMonth = calc_result(3)
AccidentInsuranceByMonth = calc_result(4)
' Open the workbook
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Sales Analysis Product Category")
Dim InstType() As Variant
InstType = Array("Accident insurance", "Vehicle insurance", "Life insurance", "Health insurance", "Travel insurance")
' Write headers
Set startCell = ws.Range(START_CELL)
For m = LBound(MONTH_NAMES) To UBound(MONTH_NAMES)
month_name = MONTH_NAMES(m)
row = 0
startCell.Offset(row, 0 + (m * 3)).Value = "Sales amount of " & month_name
row = row + 1
startCell.Offset(row, 0 + (m * 3)).Value = "Type"
startCell.Offset(row, 1 + (m * 3)).Value = "Sales"
row = row + 1
startCell.Offset(row, 0 + (m * 3)).Value = "Accident insurance"
startCell.Offset(row, 1 + (m * 3)).Value = AccidentInsuranceByMonth(m + 1)
row = row + 1
startCell.Offset(row, 0 + (m * 3)).Value = "Vehicle insurance"
startCell.Offset(row, 1 + (m * 3)).Value = VehicleInsuranceByMonth(m + 1)
row = row + 1
startCell.Offset(row, 0 + (m * 3)).Value = "Life insurance"
startCell.Offset(row, 1 + (m * 3)).Value = LifeInsuranceByMonth(m + 1)
row = row + 1
startCell.Offset(row, 0 + (m * 3)).Value = "Health insurance"
startCell.Offset(row, 1 + (m * 3)).Value = HealthInsuranceByMonth(m + 1)
row = row + 1
startCell.Offset(row, 0 + (m * 3)).Value = "Travel insurance"
startCell.Offset(row, 1 + (m * 3)).Value = TravelInsuranceByMonth(m + 1)
Next m
' TODO: replace content to real data
End Function
Function SalesUnitGraph(ByVal calc_result As Variant, ByVal FILE_PATH As String, ByVal int_month As Integer)
Dim wb As Workbook
Dim ws As Worksheet
Dim YEAR_GRAPHS_TOP As Variant
Dim YEAR_GRAPHS_LEFT As Variant
YEAR_GRAPHS_TOP = Array(1200, 1200, 1200, 1200 + 300, 1200 + 300, 1200 + 300, 1200 + 600, 1200 + 600, 1200 + 600, 1200 + 900, 1200 + 900, 1200 + 900)
YEAR_GRAPHS_LEFT = Array(0, 400, 800, 0, 400, 800, 0, 400, 800, 0, 400, 800)
Dim DATA_RANGES As Variant
DATA_RANGES = Array("A11:B16", "D11:E16", "G11:H16", "J11:K16", "M11:N16", "P11:Q16", "S11:T16", "V11:W16", "Y11:Z16", "AB11:AC16", "AE11:AF16", "AH11:AI16")
Set wb = Workbooks.Open(FILE_PATH)
Set ws = wb.Sheets("Sales Analysis Product Category")
For m = LBound(MONTH_NAMES) To UBound(MONTH_NAMES)
month_name = MONTH_NAMES(m)
data_range = DATA_RANGES(m)
ActiveSheet.Shapes.AddChart2(251, xlPie).Select
ActiveChart.SetSourceData Source:=Range(data_range)
ActiveChart.SetElement (msoElementLegendNone)
ActiveChart.SetElement (msoElementDataLabelCallout)
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = "Sales unit of " & month_name
Selection.Format.TextFrame2.TextRange.Characters.Text = "Sales unit of " & month_name
Set cho = ws.ChartObjects(ws.ChartObjects.Count)
Set cht = cho.Chart
cho.Top = YEAR_GRAPHS_TOP(m)
cho.Left = YEAR_GRAPHS_LEFT(m)
cho.Width = 400
cho.Height = 300
Next m
End Function
Function Helloworld()
Debug.Print "helloworld Sales_Analysis_Product_Category"
End Function

View File

@@ -0,0 +1,403 @@
Attribute VB_Name = "SAProductCategory"
Function CalcSalesAnalysisFileSalesAmount(ByVal TablesMeta As Variant) As Variant
Dim agent_sales_table As Variant
Dim product_sales_meta As Variant
Dim product_sales_table As Variant
Dim ps_rows As Double
Dim agent_working_performance As Variant
' agent_sales_table = TablesMeta(0)
' agent_working_performance = TablesMeta(2)
Dim VehicleInsuranceByMonth(12) As Double
Dim TravelInsuranceByMonth(12) As Double
Dim LifeInsuranceByMonth(12) As Double
Dim HealthInsuranceByMonth(12) As Double
Dim AccidentInsuranceByMonth(12) As Double
Dim MonthlyTotal(12) As Double
Dim QuartelyTotal(4) As Double
product_sales_table = TablesMeta(1)
Dim product_sales_table_row As Variant
product_sales_table_row = product_sales_table(0)
Dim val_agent_sale_sales_num As String
Dim val_agent_sale_date As String
Dim val_agent_sale_agent_name As String
Dim val_agent_sale_team As String
Dim val_agent_sale_selling_price As String
Dim val_agent_sale_commision_pct As String
Dim val_product_sales_sales_num As String
Dim val_product_sales_date As String
Dim val_product_sales_product_category As String
Dim val_product_sales_selling_unit As String
Dim val_product_sales_selling_price As String
Dim val_product_sales_comission As String
Dim val_product_sales_total_comission As String
Dim subColumn() As Variant
subColumn = Array("Travel insurance", "Health insurance", "Life insurance", "Vehicle insurance", "Accident insurance", "Monthly Total", "Quaterly Total")
For ps = 1 To product_sales_table(1)
val_product_sales_date = product_sales_table_row(ps, 2)
val_product_sales_selling_price = product_sales_table_row(ps, 5)
dt = DateValue(val_product_sales_date)
intMonth = month(dt)
intQuarter = Int((intMonth - 1) / 3) + 1
val_product_sales_product_category = product_sales_table_row(ps, 3)
If val_product_sales_product_category = "Travel insurance" Then
TravelInsuranceByMonth(intMonth) = TravelInsuranceByMonth(intMonth) + val_product_sales_selling_price
End If
If val_product_sales_product_category = "Health insurance" Then
HealthInsuranceByMonth(intMonth) = HealthInsuranceByMonth(intMonth) + val_product_sales_selling_price
End If
If val_product_sales_product_category = "Life insurance" Then
LifeInsuranceByMonth(intMonth) = LifeInsuranceByMonth(intMonth) + val_product_sales_selling_price
End If
If val_product_sales_product_category = "Vehicle insurance" Then
VehicleInsuranceByMonth(intMonth) = VehicleInsuranceByMonth(intMonth) + val_product_sales_selling_price
End If
If val_product_sales_product_category = "Accident insurance" Then
AccidentInsuranceByMonth(intMonth) = AccidentInsuranceByMonth(intMonth) + val_product_sales_selling_price
End If
MonthlyTotal(intMonth) = MonthlyTotal(intMonth) + val_product_sales_selling_price
QuartelyTotal(intQuarter) = QuartelyTotal(intQuarter) + val_product_sales_selling_price
Next ps
CalcSalesAnalysisFileSalesAmount = Array(TravelInsuranceByMonth, HealthInsuranceByMonth, LifeInsuranceByMonth, VehicleInsuranceByMonth, AccidentInsuranceByMonth, MonthlyTotal, QuartelyTotal)
End Function
Function CalcSalesAnalysisFileSalesUnit(ByVal TablesMeta As Variant) As Variant
Dim agent_sales_table As Variant
Dim product_sales_meta As Variant
Dim product_sales_table As Variant
Dim ps_rows As Double
Dim agent_working_performance As Variant
' agent_sales_table = TablesMeta(0)
' agent_working_performance = TablesMeta(2)
Dim VehicleInsuranceByMonth(12) As Double
Dim TravelInsuranceByMonth(12) As Double
Dim LifeInsuranceByMonth(12) As Double
Dim HealthInsuranceByMonth(12) As Double
Dim AccidentInsuranceByMonth(12) As Double
Dim MonthlyTotal(12) As Double
Dim QuartelyTotal(4) As Double
product_sales_table = TablesMeta(1)
Dim product_sales_table_row As Variant
product_sales_table_row = product_sales_table(0)
Dim val_agent_sale_sales_num As String
Dim val_agent_sale_date As String
Dim val_agent_sale_agent_name As String
Dim val_agent_sale_team As String
Dim val_agent_sale_selling_price As String
Dim val_agent_sale_commision_pct As String
Dim val_product_sales_sales_num As String
Dim val_product_sales_date As String
Dim val_product_sales_product_category As String
Dim val_product_sales_selling_unit As String
Dim val_product_sales_comission As String
Dim val_product_sales_total_comission As String
Dim subColumn() As Variant
subColumn = Array("Travel insurance", "Health insurance", "Life insurance", "Vehicle insurance", "Accident insurance", "Monthly Total", "Quaterly Total")
For ps = 1 To product_sales_table(1)
val_product_sales_date = product_sales_table_row(ps, 2)
val_product_sales_selling_unit = product_sales_table_row(ps, 4)
dt = DateValue(val_product_sales_date)
intMonth = month(dt)
intQuarter = Int((intMonth - 1) / 3) + 1
val_product_sales_product_category = product_sales_table_row(ps, 3)
If val_product_sales_product_category = "Travel insurance" Then
TravelInsuranceByMonth(intMonth) = TravelInsuranceByMonth(intMonth) + val_product_sales_selling_unit
End If
If val_product_sales_product_category = "Health insurance" Then
HealthInsuranceByMonth(intMonth) = HealthInsuranceByMonth(intMonth) + val_product_sales_selling_unit
End If
If val_product_sales_product_category = "Life insurance" Then
LifeInsuranceByMonth(intMonth) = LifeInsuranceByMonth(intMonth) + val_product_sales_selling_unit
End If
If val_product_sales_product_category = "Vehicle insurance" Then
VehicleInsuranceByMonth(intMonth) = VehicleInsuranceByMonth(intMonth) + val_product_sales_selling_unit
End If
If val_product_sales_product_category = "Accident insurance" Then
AccidentInsuranceByMonth(intMonth) = AccidentInsuranceByMonth(intMonth) + val_product_sales_selling_unit
End If
MonthlyTotal(intMonth) = MonthlyTotal(intMonth) + val_product_sales_selling_unit
QuartelyTotal(intQuarter) = QuartelyTotal(intQuarter) + val_product_sales_selling_unit
Next ps
CalcSalesAnalysisFileSalesUnit = Array(TravelInsuranceByMonth, HealthInsuranceByMonth, LifeInsuranceByMonth, VehicleInsuranceByMonth, AccidentInsuranceByMonth, MonthlyTotal, QuartelyTotal)
End Function
Function WriteSalesAnalysisFileSalesAmount(ByVal calc_result As Variant, ByVal FILE_PATH As String)
' TravelInsuranceByMonth,
' HealthInsuranceByMonth,
' LifeInsuranceByMonth,
' VehicleInsuranceByMonth,
' AccidentInsuranceByMonth,
' MonthlyTotal,
' QuartelyTotal
Dim TravelInsuranceByMonth As Variant
Dim HealthInsuranceByMonth As Variant
Dim LifeInsuranceByMonth As Variant
Dim VehicleInsuranceByMonth As Variant
Dim AccidentInsuranceByMonth As Variant
Dim MonthlyTotal As Variant
Dim QuartelyTotal As Variant
TravelInsuranceByMonth = calc_result(0)
HealthInsuranceByMonth = calc_result(1)
LifeInsuranceByMonth = calc_result(2)
VehicleInsuranceByMonth = calc_result(3)
AccidentInsuranceByMonth = calc_result(4)
MonthlyTotal = calc_result(5)
QuartelyTotal = calc_result(6)
Const HEADER_ROW As Long = 1
Const START_CELL As String = "A2"
Dim wb As Workbook
Dim ws As Worksheet
Dim startCell As Range
' Open the workbook
Set wb = Workbooks.Open(FILE_PATH)
' Check if the sheet exists
On Error Resume Next
Set ws = wb.Sheets("Sales Analysis Product Category")
On Error GoTo 0
' If not found, create a new sheet
If ws Is Nothing Then
Set ws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
ws.Name = "Sales Analysis Product Category"
Else
' Empty the entire sheet
ws.UsedRange.ClearContents
End If
' Write headers
With ws.Rows(HEADER_ROW)
.Cells(1).Value = "Sales Amount"
.Cells(3).Value = "Month"
End With
' Write month names
Set startCell = ws.Range("C2")
Dim monthNames() As Variant
monthNames = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
Dim i As Long
For i = LBound(monthNames) To UBound(monthNames)
startCell.Offset(0, i).Value = monthNames(i)
Next i
' Write headers
With ws.Rows(3)
.Cells(1).Value = "Product Category"
End With
' Write sub-column names
Set startCell = ws.Range("B3")
Dim subColumn() As Variant
subColumn = Array("Travel insurance", "Health insurance", "Life insurance", "Vehicle insurance", "Accident insurance", "Monthly Total", "Quaterly Total")
For sc = LBound(subColumn) To UBound(subColumn)
startCell.Offset(sc, 0).Value = subColumn(sc)
Next sc
Set startCell = ws.Range("C3")
For m = LBound(monthNames) To UBound(monthNames)
Dim int_quarter, int_month As Integer
int_month = m + 1
int_quarter = GetQuarterFromMonth(int_month)
startCell.Offset(0, m).Value = TravelInsuranceByMonth(int_month)
startCell.Offset(1, m).Value = HealthInsuranceByMonth(int_month)
startCell.Offset(2, m).Value = LifeInsuranceByMonth(int_month)
startCell.Offset(3, m).Value = VehicleInsuranceByMonth(int_month)
startCell.Offset(4, m).Value = AccidentInsuranceByMonth(int_month)
startCell.Offset(5, m).Value = MonthlyTotal(int_month)
startCell.Offset(6, m).Value = QuartelyTotal(int_quarter)
Next m
' Save and close the workbook
'wb.Close SaveChanges:=True
End Function
Function WriteSalesAnalysisFileSalesUnit(ByVal calc_result As Variant, ByVal FILE_PATH As String)
' TravelInsuranceByMonth,
' HealthInsuranceByMonth,
' LifeInsuranceByMonth,
' VehicleInsuranceByMonth,
' AccidentInsuranceByMonth,
' MonthlyTotal,
' QuartelyTotal
Application.DisplayAlerts = False
Dim TravelInsuranceByMonth As Variant
Dim HealthInsuranceByMonth As Variant
Dim LifeInsuranceByMonth As Variant
Dim VehicleInsuranceByMonth As Variant
Dim AccidentInsuranceByMonth As Variant
Dim MonthlyTotal As Variant
Dim QuartelyTotal As Variant
TravelInsuranceByMonth = calc_result(0)
HealthInsuranceByMonth = calc_result(1)
LifeInsuranceByMonth = calc_result(2)
VehicleInsuranceByMonth = calc_result(3)
AccidentInsuranceByMonth = calc_result(4)
MonthlyTotal = calc_result(5)
QuartelyTotal = calc_result(6)
Const TOP_ROW As Long = 10
Const START_CELL As String = "A2"
Dim wb As Workbook
Dim ws As Worksheet
Dim startCell As Range
' Open the workbook
Set wb = Workbooks.Open(FILE_PATH)
' Check if the sheet exists
On Error Resume Next
Set ws = wb.Sheets("Sales Analysis Product Category")
On Error GoTo 0
' If not found, create a new sheet
If ws Is Nothing Then
Set ws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
ws.Name = "Sales Analysis Product Category"
Else
' Empty the entire sheet
'ws.UsedRange.ClearContents
End If
' Write headers
With ws.Rows(TOP_ROW)
.Cells(1).Value = "Sales Unit"
.Cells(3).Value = "Month"
End With
' Write month names
Set startCell = ws.Range("C11")
Dim monthNames() As Variant
monthNames = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
Dim i As Long
For i = LBound(monthNames) To UBound(monthNames)
startCell.Offset(0, i).Value = monthNames(i)
Next i
' Write headers
With ws.Rows(12)
.Cells(1).Value = "Product Category"
End With
' Write sub-column names
Set startCell = ws.Range("B12")
Dim subColumn() As Variant
subColumn = Array("Travel insurance", "Health insurance", "Life insurance", "Vehicle insurance", "Accident insurance", "Monthly Total", "Quaterly Total")
For sc = LBound(subColumn) To UBound(subColumn)
startCell.Offset(sc, 0).Value = subColumn(sc)
Next sc
Set startCell = ws.Range("C12")
For m = LBound(monthNames) To UBound(monthNames)
Dim int_quarter, int_month As Integer
int_month = m + 1
int_quarter = GetQuarterFromMonth(int_month)
startCell.Offset(0, m).Value = TravelInsuranceByMonth(int_month)
startCell.Offset(1, m).Value = HealthInsuranceByMonth(int_month)
startCell.Offset(2, m).Value = LifeInsuranceByMonth(int_month)
startCell.Offset(3, m).Value = VehicleInsuranceByMonth(int_month)
startCell.Offset(4, m).Value = AccidentInsuranceByMonth(int_month)
startCell.Offset(5, m).Value = MonthlyTotal(int_month)
startCell.Offset(6, m).Value = QuartelyTotal(int_quarter)
Next m
For i = 0 To 100
Range("A1").Offset(0, i).EntireColumn.AutoFit
Next i
For i = 2 To 14
Range("A1").Offset(0, i).EntireColumn.ColumnWidth = 10
Next i
Dim ranges_need_merge As Variant
ranges_need_merge = Array("C1:N1", "A3:A7", "C9:E9", "F9:H9", "I9:K9", "L9:N9")
For r = LBound(ranges_need_merge) To UBound(ranges_need_merge)
range_need_merge = ranges_need_merge(r)
With Range(range_need_merge)
.Merge
.VerticalAlignment = xlVAlignCenter
.HorizontalAlignment = xlHAlignCenter
End With
Next r
Dim ranges_need_paint As Variant
ranges_need_paint = Array("A1", "C2:N2", "A3:A7", "B3:B8")
For r = LBound(ranges_need_paint) To UBound(ranges_need_paint)
range_need_merge = ranges_need_paint(r)
With Range(range_need_merge)
.Interior.Color = RGB(182, 215, 168)
End With
Next r
Range("B9").Interior.Color = RGB(0, 255, 0)
'rgb(164, 194, 244)
ranges_need_merge = Array("C10:N10", "A12:A16", "C18:E18", "F18:H18", "I18:K18", "L18:N18")
For r = LBound(ranges_need_merge) To UBound(ranges_need_merge)
range_need_merge = ranges_need_merge(r)
With Range(range_need_merge)
.Merge
.VerticalAlignment = xlVAlignCenter
.HorizontalAlignment = xlHAlignCenter
End With
Next r
ranges_need_paint = Array("A10", "C11:N11", "A12:A16", "B12:B17")
For r = LBound(ranges_need_paint) To UBound(ranges_need_paint)
range_need_merge = ranges_need_paint(r)
With Range(range_need_merge)
.Interior.Color = RGB(164, 194, 244)
End With
Next r
Range("B18").Interior.Color = RGB(0, 255, 255)
' Save and close the workbook
'wb.Close SaveChanges:=True
End Function

View File

@@ -0,0 +1,3 @@
remove-item *.bas
xlwings.exe vba edit --file .\main.xlsm

Binary file not shown.