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
Any help would be great. Thanks.![]()
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











LinkBack URL
About LinkBacks
Register To Reply
Bookmarks