dpaton05
Well-known Member
- Joined
- Aug 14, 2018
- Messages
- 2,392
- Office Version
- 365
- 2016
- Platform
- Windows
Could someone help me with a problem I am having please?
I have a spreadsheet that jobs are recorded in called an allocation sheet. The allocation sheet is based on a financial year with a sheet for every month of the year. A job is stored on a single line in the relevant monthly sheet with the date being in column A. The date is stored in the Australian format, d/mm/yyyy on the monthly sheets.
If a job is cancelled at a late stage, 3 hours will still be charged depending on the type of job. I have a sheet called sheet2 that is my calculations sheet and when a late cancel needs to be recorded I have code that copies the job details from the monthly sheet to sheet2 in the allocation sheet file. This is done calculate the price as sheet2 has a table with the hourly prices for the various services.
The problem is that the type of day changes the price, such as weekend, weekday and public holiday.
Here is an example,
Using the 5/08/2021, the code copies the date to sheet2 and this is the result.
This is where I put in the information regarding the late cancel.
Notice how the date has been copied to A30 of sheet2 using the american date format. This means that using the australian format, the date is now 8 May instead of 5 August. This creates a problem as the 8 May is a saturday and the 5 August is a weekday so it shows the incorrect price. The date needs to be copied to A30 of sheet 2 in the format d/mm/yyyy instead of m/dd/yyyy.
This is my code in the totals sheet module
Here is the rest of my code
This is where the pricing data is coming from.
I am sorry if I have provided too much info, I just wanted to make sure I included everything so someone might be able to help me.
Thanks
I have a spreadsheet that jobs are recorded in called an allocation sheet. The allocation sheet is based on a financial year with a sheet for every month of the year. A job is stored on a single line in the relevant monthly sheet with the date being in column A. The date is stored in the Australian format, d/mm/yyyy on the monthly sheets.
If a job is cancelled at a late stage, 3 hours will still be charged depending on the type of job. I have a sheet called sheet2 that is my calculations sheet and when a late cancel needs to be recorded I have code that copies the job details from the monthly sheet to sheet2 in the allocation sheet file. This is done calculate the price as sheet2 has a table with the hourly prices for the various services.
The problem is that the type of day changes the price, such as weekend, weekday and public holiday.
Here is an example,
CSS Work Allocation Sheet.60.xlsm | ||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | I | J | |||
3 | Date | Purchase order # | Req # | Name | Service | Requesting Organisation | Caseworker Name | Price ex. GST | GST | Price inc. GST | ||
4 | 25/12/2021 | 54 | 4355 | Bob | Supervised Transport | sdfg | $326.70 | $32.67 | $359.37 | |||
5 | 5/08/2021 | 56 | 4356 | Fred | Supervised Contact | $265.80 | $26.58 | $292.38 | ||||
July |
Cell Formulas | ||
---|---|---|
Range | Formula | |
I4:I5 | I4 | =IF(E4="Activities",0,H4*0.1) |
J4:J5 | J4 | =I4+H4 |
Using the 5/08/2021, the code copies the date to sheet2 and this is the result.
CSS Work Allocation Sheet.60.xlsm | |||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | I | J | K | |||
27 | Late Cancel | ||||||||||||
28 | |||||||||||||
29 | Date | Service | Unit Price | Day rate | Hours | Staff Req. | Kms Travelled | Price ex. GST | Rate | Transport $ | MaxPay | ||
30 | 8/05/2021 | Supervised Contact | $88.60 | Sat | 3 | 1 | $265.80 | $88.60 | $0.00 | $265.80 | |||
Sheet2 |
Cell Formulas | ||
---|---|---|
Range | Formula | |
C30 | C30 | =IF([@Service]="Activities",[@Activities],INDEX(Service_Types,MATCH([@Service],Sheet2!$A$5:$A$12,0),MATCH([@[Day rate]],Sheet2!$A$5:$E$5,0))) |
D30 | D30 | =IF(A30="","",IF(COUNTIF(Sheet2!$G$58:$DO$77,A30),"Public_holiday",IF(WEEKDAY(A30)=1,"Sun",IF(WEEKDAY(A30)=7,"Sat","Business_day_rate")))) |
H30 | H30 | =IF([@Service]="Activities",ROUNDDOWN([@Activities]+[@[Transport $]],2),IF([@Service]="Carer Respite",[@Hours]*[@[Unit Price]],ROUNDDOWN(((IF(OR(ISBLANK(A11),ISBLANK(D11),ISBLANK(B11)),0,[@MaxPay]))*[@[Staff Req.]]),2))) |
I30 | I30 | =INDEX(Sheet2!$A$5:$E$12,MATCH([Service],Sheet2!$A$5:$A$12,0),MATCH([Day rate],Sheet2!$A$5:$E$5,0)) |
J30 | J30 | =([@[Kms Travelled]]*1.22) |
K30 | K30 | =[Unit Price]*[Hours] |
This is where I put in the information regarding the late cancel.
CSS Work Allocation Sheet.60.xlsm | ||||||||
---|---|---|---|---|---|---|---|---|
B | C | D | E | F | G | |||
29 | Late Cancel | |||||||
30 | To enter a job as a late cancel, enter a request number first in B32, followed by the date of the proposed job in B37. The date must be entered in the format x/xx/xxxx | |||||||
31 | Request number | |||||||
32 | 4356 | |||||||
33 | Everytime you leave this sheet and return, this will be 3 | |||||||
34 | Hours charged for a late cancel | |||||||
35 | 3 | |||||||
36 | Date | |||||||
37 | 5/08/2021 | |||||||
Totals |
Notice how the date has been copied to A30 of sheet2 using the american date format. This means that using the australian format, the date is now 8 May instead of 5 August. This creates a problem as the 8 May is a saturday and the 5 August is a weekday so it shows the incorrect price. The date needs to be copied to A30 of sheet 2 in the format d/mm/yyyy instead of m/dd/yyyy.
This is my code in the totals sheet module
VBA Code:
Private Sub Worksheet_Activate()
Worksheets("Totals").Cells(35, 2).Value = 3
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B27")) Is Nothing Then
Call Transfer
' Call SortCells
ElseIf Not Intersect(Target, Range("B37")) Is Nothing Then
Call LateCancel
End If
End Sub
Here is the rest of my code
VBA Code:
Sub LateCancel()
Dim ws As Worksheet, sh As Worksheet, sht As Worksheet, QT As String, wb2 As Workbook, WbPath As String, QTPath As String
Dim Serv As String, Month As String, Service As String, LCPrice As String, AutoFilterCounter As Long
Set wb2 = ThisWorkbook
'QT = "CSS_quoting_tool_29.5.xlsm"
Set sh = wb2.Worksheets("Totals")
'values on totals sheet that the user is looking for
Dim LCReq As String: LCReq = sh.Cells(32, 2).Value
'Dim LCReq As String: LCReq = 3541
Dim LCDt As String: LCDt = sh.Cells(37, 2).Value
'Dim LCDt As String: LCDt = "7/07/2021"
Dim LateCancelHours As String: LateCancelHours = sh.Cells(35, 2).Value
Dim SheetCounter As Long: SheetCounter = 0
WbPath = ThisWorkbook.Path
QTPath = ThisWorkbook.Path & "\..\" & "\..\"
Call TurnOffFunctionality
'If Not isFileOpen(DocYearName & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Work Allocation Sheets" & "\" & Site & "\" & DocYearName & ".xlsm"
'If Not isFileOpen(QT) Then Workbooks.Open QTPath & "\" & QT
For Each ws In wb2.Worksheets
If ws.Name <> "Cancellations" And ws.Name <> "Totals" And ws.Name <> "Sheet2" Then
With ws.[A3].CurrentRegion
'On Error Resume Next
'Autofilter the late cancel date enter in B37 with dates in column 1
.AutoFilter 1, LCDt
'Autofilter the late cancel request number with request numbers in column 3
.AutoFilter 3, LCReq
'Check to see if the date cell, column A, for a job has anything in it. If it doesn't, turn the autofilter off and skip to the next sheet.
If ws.[A3].Cells.Offset(1, 0) = "" Then
.AutoFilter
SheetCounter = SheetCounter + 1
'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
If SheetCounter = 12 Then
MsgBox "A job with the date and request number entered does not exist"
End If
GoTo SkipNextSheet
End If
'Check the count Autofilter
AutoFilterCounter = .Columns(1).SpecialCells(xlCellTypeVisible).Count
'If value less than 2, only the heading is visible so skip to the next sheet.
If AutoFilterCounter < 2 Then
.AutoFilter
'Add 1 to a sheet counter
SheetCounter = SheetCounter + 1
'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
If SheetCounter = 12 Then
MsgBox "A job with the date and request number entered does not exist"
End If
GoTo SkipNextSheet
End If
With Application.Intersect(.SpecialCells(xlCellTypeVisible), .Offset(1, 0))
'Check if there is a service entered in column 5 of the filtered job.
If .Areas(1).Cells(1, 5).Value = "" Then
'Display a messagebox with a message and the sheet that has the missing service.
MsgBox "There is a job in the " & ws.Name & " sheet that matches the date and request number but does not have a " & _
"service type. Please add a service type to this job before continuing."
Call TurnOnFunctionality
.AutoFilter
Cells(32, 2).ClearContents
Cells(37, 2).ClearContents
Exit Sub
End If
'If the service column, (5), has a value, store the service in the service variable.
Service = .Areas(1).Cells(1, 5).Value
End With
'Copy data fom the job back to a calculator on the data sheet (this is the code name for sheet2) to calulcate the price again.
With Data
.Cells(30, 1) = LCDt
.Cells(30, 2) = Service
'Set the hourly figure in the lateCanel table to be the LateCancelHours variable
.Cells(30, 5) = LateCancelHours
'A late cancel will be charged for 1 staff member attending
'Therefore, set the Staff Req. figure to 1
.Cells(30, 6) = 1
End With
On Error GoTo Price
'Calculates price of late cancel on worksheet so the new price will be copied to the allocation sheet instead of the previous price
Calculate
LCPrice = Data.Cells(30, 8).Value
Price:
Select Case Err.Number
Case Is = 13
MsgBox "There is a problem with the spelling of the service type on the " & ws.Name & " sheet for the job that matches " _
& "the date and request number. Please check the spelling and try again. Please note, the service type is case sensitive."
'Cells(32, 2).ClearContents
'Cells(37, 2).ClearContents
.AutoFilter
Call TurnOnFunctionality
Exit Sub
End Select
On Error GoTo 0
With Application.Intersect(.SpecialCells(xlCellTypeVisible), .Offset(1, 0))
Dim LTCnclDate As String
.Areas(1).Cells(1, 1).Value = "LT CNCL " & .Areas(1).Cells(1, 1).Value
.Areas(1).Cells(1, 8).Value = LCPrice
.Areas(1).Cells(1, 9).Formula = "=IF(RC[-4]=""Activities"",0,RC[-1]*0.1)"
.Areas(1).Cells(1, 10).Formula = "=RC[-1]+RC[-2]"
End With
.AutoFilter
End With
End If
SkipNextSheet:
Next ws
'sh.Range("B32,B37").ClearContents
Call TurnOnFunctionality
End Sub
Public Sub TurnOffFunctionality()
'Turn off automatic calculations, events and screen updating
With Application
.Calculation = xlCalculationManual
.DisplayStatusBar = False
.EnableEvents = False
.ScreenUpdating = False
End With
End Sub
Public Sub TurnOnFunctionality()
'Turn on automatic calculations, events and screen updating
With Application
.Calculation = xlCalculationAutomatic
.DisplayStatusBar = True
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
This is where the pricing data is coming from.
CSS Work Allocation Sheet.60.xlsm | |||||||
---|---|---|---|---|---|---|---|
A | B | C | D | E | |||
5 | Business_day_rate | Sat | Sun | Public_Holiday | |||
6 | Supervised Transport | 57 | 69.1 | 87.8 | 108.9 | ||
7 | Supervised Contact | 73.1 | 88.6 | 112.6 | 139.7 | ||
8 | Tutoring | 73.1 | 88.6 | 112.6 | 139.7 | ||
9 | Daytime Respite | 73.1 | 88.6 | 112.6 | 139.7 | ||
10 | Overnight Respite Awake Time | 74.4 | 88.6 | 112.6 | 139.7 | ||
11 | Overnight Respite Sleepover | 183 | 183 | 183 | 183 | ||
12 | Carer Respite | 165 | 165 | 165 | 165 | ||
Sheet2 |
I am sorry if I have provided too much info, I just wanted to make sure I included everything so someone might be able to help me.
Thanks