PDA

View Full Version : No of records for each person 90 days old



danesrood
09-28-2015, 03:03 AM
Hi

I have something like 5000 records on a worksheet containing numerous columns but the ones that I am interested in are a staff number in column K and a date in column H.

What I would like to calculate is the number of records for each staff number that are 90 or more working days (not Saturday or Sunday) old from today.

Your help would be much appreciated

SamT
09-28-2015, 07:11 AM
Each Staff number has more than one record, so you need more than one count.

Do you have a separate list of unique staff numbers where the counts can be recorded? Will we need to create this list?

What about holidays?

Please provide full details of the desired result.

danesrood
09-28-2015, 09:00 AM
Hi Sam

I'm sorry that I didn't explain it to we'll.

Yes there is a separate list of the staff numbers that at the moment will be a couple of columns to the right and there will be quite a few records for each member of staff.
All that I'm looking for is the number of cases that they have had for 90 working days or more. I don't think that there is a need to worry about holidays.

I hope that makes sense.

My thanks for taking an interest.

SamT
09-28-2015, 05:16 PM
So Column M is a list of unique staff numbers and we can record the Count of records for each staff in column N next to the relevant staff number.

As we search thru K for old dates, we'll be adding up the values in Column N next to the number in M that corresponds to the matching number in H.

danesrood
09-28-2015, 11:14 PM
Hi Sam

Yes M contains a unique list of the staff numbers and the count goes in N

However you have got the wrong columns for the data columns to be checked.

H is the column for the dates and column K contains the staff numbers.

Regards from England

SamT
09-29-2015, 03:03 PM
Yes M contains a unique list of the staff numbers and the count goes in N
Lucky guess on my part about the missing details.

BTW, I have been working on the 90 work days in my spare time. However if holidays aren't critical then why not just use 18 weeks ago?

~ 90 workdays ago (18 weeks) = Date - 126

If you can live with counting records older than exactly 18 weeks, this sub should work

Option Explicit

Sub Count90DayOldRecords()
Dim CutoffDate As Date
Dim RecordDate As Date
Dim RecordDates As Range
Dim Sht As Worksheet
Dim StaffNumbers As Range
Dim Cel As Range
Dim LastCel As Range
Dim Found As Range
Dim Answer As Long

Set Sht = Sheets("Sheet1") 'Edit Sheet1 to name of actual worksheet

With Sht
Set LastCel = .Cells(Rows.Count, "H").End(xlUp)
Set RecordDates = Range(.Range("H2"), LastCel) 'Assumes headers in Row 1. Edit if needed.

Set LastCel = .Cells(Rows.Count, "M").End(xlUp)
Set StaffNumbers = Range(.Range("M2"), LastCel)'Assumes headers in Row 1. Edit if needed.

Set LastCel = Nothing

CutoffDate = DateAdd("D", -126, Date)

'''' Clear previous counts
For Each Cel In StaffNumbers
Cel.Offset(0, 1).ClearContents
Next Cel

''''Start Counting
For Each Cel In RecordDates
If CDate(Cel.Value) < CutoffDate Then
''''Check if valid staff number
Set Found = StaffNumbers.Find(What:=Cel.Offset(0, 3).Value, After:=.Range("M1")) 'Assumes headers in Row 1. Edit if needed.
If Found Is Nothing Then 'Invalid number
Answer = MsgBox("Staff Number " & Cel.Offset(0, 3) & " not found." & vbCr _
& "Press Yes to continue counting. Press No to stop counting and retry later.")
If Answer = vbNo Then
Exit Sub
Else 'Continue with counting
GoTo LoopNext
End If
Else 'Increment count for this staff number
With Found
.Offset(0, 1).Value = .Offset(0, 1).Value + 1
End With
End If
End If
LoopNext:
Next Cel

End With 'Sht
End Sub

danesrood
09-30-2015, 06:30 AM
Sam

I've tried the code and it breaks down at this line with the Run Time error 13 Type Mismatch

Set Found = StaffNumbers.Find(What:=Cel.Offset(0, 3).Value, After:=.Range("M1")) 'Assumes headers in Row 1. Edit if needed.

Just to confirm that column M has numbers like 10019344 and H has dates like 13/08/2014 02:18

SamT
09-30-2015, 07:18 AM
Remote troubleshooting is time consuming. Lets start with replacing these two lines


If CDate(Cel.Value) < CutoffDate Then
''''Check if valid staff number
With these two


If DateDiff("d", Cel, Date) > 126 Then
''''Check if valid staff number


BTW, if Cel is in Column H, then, Cel.Offset(0, 3) refers to column K

danesrood
09-30-2015, 11:24 PM
Sam

No change I'm afraid stlll Run Time error 13 Type mismatch at the same line.

Confirmation of the layout:

Sheet Name "Sheet1"
Header in row1
Columns A to K contain data at present down to row 5000
H = dates in the format dd/mm/hhhh hh:mm
K = Staff number against each record like 67387303
L is a blank column
M = Unique list of the individual staff numbers like 67387303
N is where I would like the results shown

My sincere thanks for taking the time which is much appreciated

SamT
10-01-2015, 08:16 AM
Select Columns K and M at the same time and Format Cells on them to General or Text, then Format their Horizontal Alignment as desired, then insure that Merge Cells and Wrap Text are OFF. Note that formatting them to Text may crash some other Procedure (macro) due to it being too specific. If so, we'll work on that peculiarity

If that doesn't work then change

Set Found = StaffNumbers.Find(What:=Cel.Offset(0, 3).Value, After:=.Range("M1")) 'Assumes headers in Row 1. Edit if needed.

To

Set Found = StaffNumbers.Find(What:=Trim(Cel.Offset(0, 3)), After:=.Range("M1")

danesrood
10-02-2015, 01:24 AM
Sam

No joy I'm afraid.

I've changed the Format without success and I then replaced the line of code as suggested but this turned the line red and came up with Compiler Error Syntax Error

SamT
10-02-2015, 08:32 AM
Please paste the code from your workbook for us to look at.

p45cal
10-02-2015, 01:09 PM
You could try a pivot table.
In the attached is a table with column H having dates 90 days ago from today plus or minus 10 days. There's conditional formatting in that column to highlight dates > 90 days ago (this is only for checking results using the autofilter). There are some staff numbers in column K. There's a pivot table in the vicinity of cell M41. Currently it's filtered on mydates for before 3rd jul 2015. Currently pivot shows only staff numbers which have dates older than 3rd jul 2015 but this can be changed to show all staff numbers leaving blank the count if they don't have any dates older than that. The pivot takes care of creating a unique staff number list. It can be sorted by count if needed.

I've just noticed it's 90 working days. I'm not going to change anything in the workbook - you get the principle. I've added a calculation at cell O3 which shows 90 working days ago, so you'd use this date in filtering the pivot table on mydate instead of 3rd jul 2015.

danesrood
10-04-2015, 11:20 PM
Sam

Here is the latest code after making the changes that you suggested. I confirm that I have changed the format for columns K & M to Text and that there are no merged cells or Word Wrap
The latest code change that you suggested comes up red with the message compile error syntax error.
Option Explicit


Sub Count90DayOldRecords()
Dim CutoffDate As Date
Dim RecordDate As Date
Dim RecordDates As Range
Dim Sht As Worksheet
Dim StaffNumbers As Range
Dim Cel As Range
Dim LastCel As Range
Dim Found As Range
Dim Answer As Long

Set Sht = Sheets("Sheet1") 'Edit Sheet1 to name of actual worksheet

With Sht
Set LastCel = .Cells(Rows.Count, "H").End(xlUp)
Set RecordDates = Range(.Range("H2"), LastCel) 'Assumes headers in Row 1. Edit if needed.

Set LastCel = .Cells(Rows.Count, "M").End(xlUp)
Set StaffNumbers = Range(.Range("M2"), LastCel) 'Assumes headers in Row 1. Edit if needed.

Set LastCel = Nothing

CutoffDate = DateAdd("D", -126, Date)

'''' Clear previous counts
For Each Cel In StaffNumbers
Cel.Offset(0, 1).ClearContents
Next Cel

''''Start Counting
For Each Cel In RecordDates
'If CDate(Cel.Value) < CutoffDate Then
' ''''Check if valid staff number
'replaced previous two
If DateDiff("d", Cel, Date) > 126 Then
''''Check if valid staff number
' Set Found = StaffNumbers.Find(What:=Cel.Offset(0, 3).Value, After:=.Range("M1")) 'Assumes headers in Row 1. Edit if needed.
'replaced with
Set Found = StaffNumbers.Find(What:=Trim(Cel.Offset(0, 3)), After:=.Range("M1")
If Found Is Nothing Then 'Invalid number
Answer = MsgBox("Staff Number " & Cel.Offset(0, 3) & " not found." & vbCr _
& "Press Yes to continue counting. Press No to stop counting and retry later.")
If Answer = vbNo Then
Exit Sub
Else 'Continue with counting
GoTo LoopNext
End If
Else 'Increment count for this staff number
With Found
.Offset(0, 1).Value = .Offset(0, 1).Value + 1
End With
End If
End If
LoopNext:
Next Cel

End With 'Sht
End Sub

SamT
10-05-2015, 07:00 AM
Missing the final ")" in

Set Found = StaffNumbers.Find(What:=Trim(Cel.Offset(0, 3)), After:=.Range("M1"))

danesrood
10-05-2015, 11:35 PM
Hi Sam

That just brings us back to Run Time Error 13 Type Mismatch.

p45cal
10-06-2015, 12:53 AM
Take out the:
After:=.Range("M1")
altogether; M1 is outside the StaffNumbers range anyway.

If that still doesn't solve it then consider setting some of the other arguments on that line.
Range.Find remembers some of those arguments (whether set by vba or the user using Find manually on the sheet). Specifically, from Help:
"The settings for LookIn, LookAt, SearchOrder, and MatchByte are saved each time you use this method. If you do not specify values for these arguments the next time you call the method, the saved values are used. Setting these arguments changes the settings in the Find dialog box, and changing the settings in the Find dialog box changes the saved values that are used if you omit the arguments. To avoid problems, set these arguments explicitly each time you use this method."

Don't worry about MatchByte but what isn't mentioned is that SearhFormat should also be set to False:
SearchFormat:=False