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.

salesdata.xlsx

Solved

Posted on 2011-04-29

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

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

8 Comments

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.

salesdata.xlsx

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

Kevin

Q-26985135.xlsx

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

=IF(AND(B2>$F$1,COUNTIFS(A

sew

```
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
Next
MsgBox "Total found from " & INITIAL_MONTH & " >= " & TARGET_VALUE & " = " & intTotalCount
End Sub
```

```
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.UsedRange.Clear
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
```

Kevin

Q-26985135.xlsx

=IF(SUM((C$2:C2=C3)*(D$2:D

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:

=COUNTIF(D:D,TRUE)

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.

Kevin

Q-26985135.xlsx

By clicking you are agreeing to Experts Exchange's Terms of Use.

Title | # Comments | Views | Activity |
---|---|---|---|

Automate double vlookup using VBA | 11 | 57 | |

VBA double quote escaping question | 8 | 27 | |

Employees list | 3 | 31 | |

Excel 2010 - Custom Calculation in Pivot Table | 12 | 19 |

This article will show, step by step, how to integrate R code into a R Sweave document

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

Connect with top rated Experts

**8** Experts available now in Live!