Count the number of people in a table that meet a given target in consecutive months?

Posted on 2011-04-29
Last Modified: 2012-05-11
Hi experts
I need to use vba code to count the number of people that meet a target in consecutive months
example the target is 30 and above thus the total number of people that meet this target in consecutive months where the second month is 31/12/2010 is  2

Sam gets 50 in the first month and 45 in the second

peter gets 40 in the firts month and 40 in he second , thus 2 people meet the target in consecutive months.

The tabel itself cosnsist of over 10,000 records with over 2000 individuals is there a way to do this using vba?


Date                 Target           Name        
31/11/2010           50                Sam
31/11/2010           40                Dan
31/11/2010           40                Kent
31/11/2010           30                Peter
31/12/2010           45                Sam
31/12/2010           40                Kent        
31/12/2010           25                Peter
31/01/2011           40                Chris
31/01/2011           10                Sam

Question by:Thrawn3000
    LVL 19

    Expert Comment

    You can even do it without using VBA

    positive side is that it automatically calculates changes, drawback is that you have to type in all distinct names by hand and drag-expand the formula.

    Author Comment

    Thanks akoster
    I have something similar to this working in my attached vba code, but given the size of the data
    and number of names of consultants, please see tab wksCleandata I need to automate this in VBA
    the tab wksDashboad shows where the sum of consultants who met a target for consecutive months should be, can this be simplified and automted so there uis no need to show distinct names.

     Devel-Target-update5-automate.xlsm Devel-Target-update5-automate.xlsm
    LVL 81

    Expert Comment

    by:zorvek (Kevin Jones)
    You can do it with formulas. Note that the formula in cell E2 is different than the one in E3. Not a single formula but a row of formulas. The final count is the number of sales people that had two consecutive months of sales greater than a target threshold. If a salesperson had three or more consecutive months o multiple instances of two consecutive months it is still counted as one instance.


    Author Comment


    that looks usefull can I alter this easily to pick up 3 consecutive months of targets hit or x consectuive months?


    LVL 14

    Expert Comment

    Here is a VBA script that should do what you need. You just need to change the TARGET_VALUE and INITIAL_MONTH fields and let it run.


    Sub CountPeople()
        Const TARGET_VALUE = 40
        Const INITIAL_MONTH = "31/11/2010"
        Set objDic = CreateObject("Scripting.Dictionary")
        intTotalCount = 0
        For intSrcRow = 2 To Cells(Cells.Rows.Count, "C").End(xlUp).Row
            strCurDate = Cells(intSrcRow, "A").Value
            strCurTarget = Cells(intSrcRow, "B").Value
            strCurName = Cells(intSrcRow, "C").Value
            If Not objDic.Exists(strCurName) And strCurDate = INITIAL_MONTH And strCurTarget >= TARGET_VALUE Then
                objDic.Add strCurName, strCurName & "," & strCurTarget & "," & Day(DateSerial(Mid(strCurDate, 7, 4), Mid(strCurDate, 4, 2) + 1, 0)) & Mid(strCurDate, 3)
            ElseIf strCurTarget >= TARGET_VALUE Then
                If objDic.Item(strCurName) <> "" Then
                    aryPrevData = Split(objDic.Item(strCurName), ",")
                    strPrevName = aryPrevData(0)
                    strPrevTarget = aryPrevData(1)
                    strPrevDate = aryPrevData(2)
                    dtPrevDate = DateSerial(Mid(strPrevDate, 7, 4), Mid(strPrevDate, 4, 2), Left(strPrevDate, 2))
                    dtCurDate = DateSerial(Mid(strCurDate, 7, 4), Mid(strCurDate, 4, 2), Left(strCurDate, 2))
                    If DateDiff("m", dtPrevDate, dtCurDate) = 1 Then
                        intTotalCount = intTotalCount + 1
                        'MsgBox "ADDED: " & vbCrLf & FormatDateTime(dtCurDate, vbGeneralDate) & vbCrLf & FormatDateTime(dtPrevDate, vbGeneralDate)
                    End If
                End If
            End If
        MsgBox "Total found from " & INITIAL_MONTH & " >= " & TARGET_VALUE & " = " & intTotalCount
    End Sub

    Open in new window

    LVL 19

    Accepted Solution

    You can post this macro in the wksDashboard section of the VBA editor :
    Sub process_consulants()
    Dim pos As Double
    Dim maxpos As Double
    Dim nr As Double
    Dim item As Range
    Dim names() As String
    Dim ws As Worksheet
        '-- determine distinct consultants
        nr = 0
        ReDim names(0)
        Application.ScreenUpdating = False
        Set ws = Worksheets("wksCleanData")
        maxpos = ws.UsedRange.Rows.Count
        For Each item In ws.UsedRange.Columns(8).Cells
            Application.StatusBar = "Parsing consultants : " & nr & " / " & maxpos
            For pos = 0 To UBound(names)
                If names(pos) = item Then Exit For
            Next pos
            If pos > UBound(names) And item <> "Consultant" Then
                If pos = 1 And names(0) = "" Then pos = 0
                ReDim Preserve names(pos)
                names(pos) = item
            End If
            nr = nr + 1
        Next item
        Application.ScreenUpdating = True
        '-- use names to generate formulae
        Set ws = Worksheets("wksResults")
        ws.Range("A1") = "Target : "
        ws.Range("B1") = 0.3  '-- 0.3 => 30%
        ws.Range("A3") = "Name"
        For pos = 0 To UBound(names)
            Application.StatusBar = "Writing results for consultants : " & pos & " / " & UBound(names)
            ws.Range("A" & pos + 4) = names(pos)
            ws.Range("B" & pos + 4).FormulaR1C1 = "=COUNTIFS(wksCleanData!R2C8:R" & maxpos & "C8, ""="" & RC[-1], wksCleanData!R2C9:R" & maxpos & "C9, "">"" & R1C2)"
        Next pos
        Application.StatusBar = "Finished !"
        Application.Wait Now + TimeValue("0:0:01")
        Application.StatusBar = False
        Set ws = Nothing
    End Sub

    Open in new window

    LVL 81

    Expert Comment

    by:zorvek (Kevin Jones)
    Here is a three month solution with formulas. I removed the first row formula since it was not really needed.

    LVL 81

    Assisted Solution

    by:zorvek (Kevin Jones)
    A new solution with only one column used. In the second data row I used this array formula and copied it down to the end of the list:


    In cell G1 I entered the threshold sales amount. In cell G2 I entered the number of consecutive months. In cell G3 I entered this formula to count the number of salespeople satisfying the criteria:


    The formulas assume the dates are in column A, the sales are in column B, and the names are in column C. Column D is used as the helper column (long formula above).

    See the attached example.


    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    6 Surprising Benefits of Threat Intelligence

    All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

    Suggested Solutions

    This article will show, step by step, how to integrate R code into a R Sweave document
    If you’re thinking to yourself “That description sounds a lot like two people doing the work that one could accomplish,” you’re not alone.
    The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
    This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

    761 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    8 Experts available now in Live!

    Get 1:1 Help Now