Hi,
So the initial problem I'm trying to solve is I have a spreadsheet with a column with a lists of dates and another column with a list of corresponding priority. So what I want it to do is go through the list, start a tab of how many workdays there are total in the range, also tabulate how many of each instance of priority there are and then return that information in a different spreadsheet to represent how many of these occur on a daily (averaged) basis. With the On Error Goto removed, the error occurs when I use the DateDiff function
Sub ClosedPerDayByPriority()
Dim LSearchRow As Integer
Dim myCount As Integer
Dim def_high As Integer
Dim def_med As Integer
Dim def_low As Integer
Dim s_date As String
Dim start_date As Date
Dim current_date As Date
Dim IsWorkday As Boolean
Dim workdays As Integer
On Error GoTo Err_Execute
'Start search in row 2
LSearchRow = 2
workdays = 0
def_high = 0
def_med = 0
def_low = 0
Sheets(Sheets.Count).Select
s_date = Application.InputBox(Prompt:= _
"Please select a start date for calculation (dd/mm/yyyy).", _
Title:="SPECIFY DATE", Type:=2)
current_date = Date
start_date = DateValue(s_date)
myCount = DateDiff(d, start_date, current_date)
While myCount > 0
Select Case Weekday(current_date)
Case vbMonday To vbFriday
IsWorkday = True
Case Else
IsWorkday = False
End Select
If IsWorkday = True Then
workdays = workdays + 1
'Searches for various instances of priority
If Range("F" & CStr(LSearchRow)).Value = current_date Then
If Range("Q" & CStr(LSearchRow)).Value = "High" Then
def_high = def_high + 1
ElseIf Range("Q" & CStr(LSearchRow)).Value = "Medium" Then
def_med = def_med + 1
ElseIf Range("Q" & CStr(LSearchRow)).Value = "Low" Then
def_low = def_low + 1
End If
End If
Else
LSearchRow = LSearchRow + 1
myCount = myCount - 1
End If
Wend
With Worksheets(1)
.Range("B16").Value = def_high / workdays
.Range("C16").Value = def_med / workdays
.Range("D16").Value = def_low / workdays
End With
'Selects the analysis sheet
Sheets(1).Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
Any help would be great. Thanks.
Bookmarks