Date is being copied from Aus format to US format where it needs to be from Aus format to Aus.

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. 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,
CSS Work Allocation Sheet.60.xlsm
ABCDEFGHIJ
3DatePurchase order #Req #NameServiceRequesting OrganisationCaseworker NamePrice ex. GSTGSTPrice inc. GST
425/12/2021544355BobSupervised Transportsdfg$326.70$32.67$359.37
55/08/2021564356FredSupervised Contact$265.80$26.58$292.38
July
Cell Formulas
RangeFormula
I4:I5I4=IF(E4="Activities",0,H4*0.1)
J4:J5J4=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
ABCDEFGHIJK
27Late Cancel
28
29DateServiceUnit PriceDay rateHoursStaff Req.Kms TravelledPrice ex. GSTRateTransport $MaxPay
308/05/2021Supervised Contact$88.60Sat31$265.80$88.60$0.00$265.80
Sheet2
Cell Formulas
RangeFormula
C30C30=IF([@Service]="Activities",[@Activities],INDEX(Service_Types,MATCH([@Service],Sheet2!$A$5:$A$12,0),MATCH([@[Day rate]],Sheet2!$A$5:$E$5,0)))
D30D30=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"))))
H30H30=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)))
I30I30=INDEX(Sheet2!$A$5:$E$12,MATCH([Service],Sheet2!$A$5:$A$12,0),MATCH([Day rate],Sheet2!$A$5:$E$5,0))
J30J30=([@[Kms Travelled]]*1.22)
K30K30=[Unit Price]*[Hours]



This is where I put in the information regarding the late cancel.
CSS Work Allocation Sheet.60.xlsm
BCDEFG
29Late Cancel
30To 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
31Request number
324356
33Everytime you leave this sheet and return, this will be 3
34Hours charged for a late cancel
353
36Date
375/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
ABCDE
5Business_day_rateSatSunPublic_Holiday
6Supervised Transport5769.187.8108.9
7Supervised Contact73.188.6112.6139.7
8Tutoring73.188.6112.6139.7
9Daytime Respite73.188.6112.6139.7
10Overnight Respite Awake Time74.488.6112.6139.7
11Overnight Respite Sleepover183183183183
12Carer Respite165165165165
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
 

Some videos you may like

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
This line of code in the sub LateCancel puts the date in B37 of the totals sheet into the variable LCDt.
VBA Code:
Dim LCDt As String: LCDt = sh.Cells(37, 2).Value

I even set a watch on the variable and the correct format appeared in the watch window. I continue stepping through the code until this line
VBA Code:
.Cells(30, 1) = LCDt

I hover over LCDt when the line is highlighted and it tells me 5/08/2021, which is the correct format I want. I step to the next line and I hover over .Cells(30, 1) now from the previous line and it reads 8/05/2021. It somehow changes the date format automatically. How do I get it to enter 5/08/2021 into .cells(30,1)?
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,955
Office Version
  1. 365
Platform
  1. Windows
Try:
VBA Code:
Dim LCDt As String: LCDt = CDate(sh.Cells(37, 2).Value)
VBA Code:
.Cells(30, 1) = CDate(LCDt)
 
Solution

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Thanks for the reply. That doesn't seem to work.

The correct date is identified in the correct month and the Late Cancel text is added to the date as per the code.

The date field for a late cancel, A30 of sheet2 doesn't seem to change with the new date that is entered in B37 of the totals sheet so it doesn't seem to matter the date that is entered in terms of giving a different price for weekdays, weekends, etc as it looks at A30 to calculate the price but that doesn't update.
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

The date in A30 of sheet2 seems to change to 1/11/2021 each time, regardless of different dates that are entered in the monthly sheets.
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I meant to say regardless of different dates that are entered in the totals sheet.
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

Actually, it does work. I was trying different bits of code but it wasn't working. I had forgotten to remove them. I did so and it worked perfectly.

The commented out bits were the rogue bits of code causing the trouble.

VBA Code:
                                    With Data
                                        .Cells(30, 1) = CDate(LCDt)
                                        '.Cells(30, 1) = Format(Date, "d/mm/yyyy")
                                        '.Cells(30, 1).NumberFormat = "d/mm/yyyy"
                                        .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

Thankyou.
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,955
Office Version
  1. 365
Platform
  1. Windows
Glad it works.:)
I just want to point out something.
Usually the problem with using non-US format date is the fact that vba is using US date format which is month-day-year. So in certain situation the order of day & month is not what we might expect. And sometimes this kind of problem can be resolved by using CDate function.

Here's an example:
My regional setting is day-month-year like yours.
VBA Code:
Sub tryCDate()
Dim tx As String
tx = "2-4-20"
Range("A1") = tx
Range("B1") = Format(Range("A1"), "yyyy-mmm-dd")

'Using CDate
Range("A2") = CDate(tx)
Range("B2") = Format(Range("A2"), "yyyy-mmm-dd")

End Sub

de Userform template-example-sample.xlsm
AB
104/02/20202020-Feb-04
202/04/20202020-Apr-02
Sheet2


As you can see the string "2-4-20" is interpreted by VBA as "2020-Feb-04" but using CDate it is "2020-Apr-02".
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
So CDate always converts a date to d/mm/yyyy?
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,955
Office Version
  1. 365
Platform
  1. Windows
So CDate always converts a date to d/mm/yyyy?
Actually I'm not sure about that, it looks like it will follow the regional setting. So if you're using US format then the code above will generate the same output (with or without CDate), so both will be February 4 not April 2.
But I can't find any references on this. So I hope someone else here can give more information.
 

Watch MrExcel Video

Forum statistics

Threads
1,126,997
Messages
5,622,081
Members
415,875
Latest member
Tarali

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top