Attribute VB_Name = "BestSalesEachMonth" Option Explicit Sub Helloworld() Debug.Print "helloworld" End Sub ' get the integer month from date Function GetMonthFrDate(ByVal date_string As String) As Integer Dim intMonth As Integer Dim dt As String dt = DateValue(date_string) intMonth = month(dt) GetMonthFrDate = intMonth End Function ' get the integer quarter from date Function GetQuarterFrDate(ByVal date_string As String) As Integer Dim intQuarter As Integer Dim intMonth As Integer Dim dt As String dt = DateValue(date_string) intMonth = month(dt) GetQuarterFrDate = Int((intMonth - 1) / 3) + 1 End Function Function CountFigures(ws As Worksheet, ByVal start_row As Integer, ByVal last_row As Integer) Dim SalesNewCaseByMonth As Integer Dim SalesCollapsedCaseByMonth As Integer Dim i, j As Integer ' variable for result Dim monthly_total_sell, month_total_commission Set monthly_total_sell = CreateObject("Scripting.Dictionary") Set month_total_commission = CreateObject("Scripting.Dictionary") Dim team_a_best, team_a_best_value, team_a_best_name, team_a_best_commission Set team_a_best = CreateObject("Scripting.Dictionary") Set team_a_best_value = CreateObject("Scripting.Dictionary") Set team_a_best_name = CreateObject("Scripting.Dictionary") Set team_a_best_commission = CreateObject("Scripting.Dictionary") Dim team_b_best, team_b_best_value, team_b_best_name, team_b_best_commission Set team_b_best = CreateObject("Scripting.Dictionary") Set team_b_best_value = CreateObject("Scripting.Dictionary") Set team_b_best_name = CreateObject("Scripting.Dictionary") Set team_b_best_commission = CreateObject("Scripting.Dictionary") For j = 1 To 12 team_a_best(CStr(j)) = 0 team_b_best(CStr(j)) = 0 Next j For i = start_row To last_row Dim date_value As String Dim agent_name As String Dim team As String Dim temp_key As String Dim selling_price, commision_pct, commision_value As Double Dim int_month, int_quarter As Integer date_value = ReadCellValue("B" & CStr(i)) int_month = GetMonthFrDate(date_value) int_quarter = GetQuarterFrDate(date_value) agent_name = ReadCellValue("C" & CStr(i)) team = ReadCellValue("D" & CStr(i)) selling_price = CDbl(ReadCellValue("E" & CStr(i))) commision_pct = CDbl(ReadCellValue("F" & CStr(i))) commision_value = selling_price * commision_pct temp_key = agent_name & "," & int_month ' create if not found agent_name If (Not (IsEmpty(temp_key)) And Not (monthly_total_sell.exists(temp_key))) Then For j = 1 To 12 monthly_total_sell(agent_name + "," + CStr(j)) = 0 Next j End If monthly_total_sell(agent_name + "," + CStr(int_month)) = monthly_total_sell(agent_name + "," + CStr(int_month)) + selling_price month_total_commission(agent_name + "," + CStr(int_month)) = month_total_commission(agent_name + "," + CStr(int_month)) + commision_value ' is in team A? If (CheckSalesIsInTeamA(agent_name)) Then If (monthly_total_sell(agent_name + "," + CStr(int_month)) > team_a_best(CStr(int_month))) Then team_a_best_name(CStr(int_month)) = agent_name team_a_best_value(CStr(int_month)) = monthly_total_sell(agent_name + "," + CStr(int_month)) team_a_best_commission(CStr(int_month)) = month_total_commission(agent_name + "," + CStr(int_month)) End If End If ' is in team B? If (CheckSalesIsInTeamB(agent_name)) Then If (monthly_total_sell(agent_name + "," + CStr(int_month)) > team_b_best(CStr(int_month))) Then team_b_best_name(CStr(int_month)) = agent_name team_b_best_value(CStr(int_month)) = monthly_total_sell(agent_name + "," + CStr(int_month)) team_b_best_commission(CStr(int_month)) = month_total_commission(agent_name + "," + CStr(int_month)) End If End If Next i CountFigures = Array(monthly_total_sell, _ team_a_best_name, _ team_a_best_value, _ team_a_best_commission, _ team_b_best_name, _ team_b_best_value, _ team_b_best_commission _ ) End Function Function Run(ws As Worksheet) 'Dim ws As Worksheet 'Set ws = ThisWorkbook.Sheets("Sheet1") Dim row_count As Integer Dim rw As Variant Dim count_figures_result As Variant Dim start_row, last_row As Integer start_row = 2 last_row = getLastRow(start_row) count_figures_result = CountFigures(ws, start_row, last_row) Run = count_figures_result Debug.Print "done" End Function ' get the last row for a given xls sheet Function getLastRow(ByVal start_row As Integer) Dim last_row As Boolean Dim last_check_row As Integer Dim scan_row As Integer Dim i As Integer Dim cell_value_1 As String Dim next_row_1 As Integer scan_row = start_row last_check_row = 9999 For i = start_row To last_check_row scan_row = i last_row = True next_row_1 = i + 1 cell_value_1 = ReadCellValue("A" & CStr(next_row_1)) If (cell_value_1 <> "") Then last_row = False End If If (last_row = True) Then 'Debug.Print "last row found" Exit For End If Next i getLastRow = scan_row End Function ' get the value from cell for a given address Function ReadCellValue(cell_addr As String) ReadCellValue = Worksheets("Sheet1").Range(cell_addr).Value End Function ' canned method to open excel file Function OpenFile(sPath As String) Dim wb As Workbook Set wb = Workbooks.Open(sPath) Dim count_figures_result As Variant If Not (wb.Sheets("Sheet1") Is Nothing) Then count_figures_result = BestSalesEachMonth.Run(wb.Sheets("Sheet1")) End If OpenFile = count_figures_result wb.Close savechanges:=False End Function