Date Issue Between Users

[JBDB]

I have a piece of VBA (see in full below) that processes data from one sheet and outputs into another. Both spreadsheets are stored in a SharePoint site.

The code works absolutely fine on my PC and one member of the team who run it.
However, on the other 2 team members PCs an error occurs.

There are dates in column E that come into the sheet with "." separators (not "/" or "-"), but these are corrected earlier in the code and I don't believe the issue lies here.

Using the message boxes added above (marked in red) I figured out the issue.
I believe the issue is occurring in the highlighted Arr(i,5) > DateAdd ("d", 6 , CDate(SatWkStart))).
The code (on the 2 specific users PCs) states for example that:

• the 29th of March is not greater than the 25th March nor is it less than the 31st March

Which is of course, incorrect.
However it works fine on my PC and the other user in the team.

Any ideas? Is there a date setting somewhere?

Full Code:

Option Explicit

Sub Create_Timesheet_Old()
Dim i As Long, j As Long, i2 As Long, Ctr As Long, LastRow As Long, Ctr2 As Long
Dim EmpCode As String
Dim Arr As Variant
Dim FileName As String
Dim NewTS As Workbook, Master As Workbook
Dim SatWkStart As String
Dim ContractNo As String, Remarks As String
Dim CNCtr As Long, CNColRef As Long
Dim NewCN As Boolean
Dim Continue As Boolean
Dim x1 As Single, x15 As Single
Dim iError As Long
Const SaveFolder As String = "XX-SHAREPOINT-LOCATION-XX"

Call TurnStuffOff
Set Master = ThisWorkbook

'check for '.' in dates
If InStr(1, Master.Sheets("Import").Cells(2, 5), ".") = 0 Then
    MsgBox "Please insert new data, this has already been processed" & Chr(13) & "If this issue persists, please contact XX-MY EMAIL-XX"
    Call TurnStuffOn
    Exit Sub
End If

'sort out date col
Arr = Master.Sheets("Import").Range("A1").CurrentRegion
For i = 2 To UBound(Arr, 1)
    Master.Sheets("Import").Cells(i, 5) = Replace(Master.Sheets("Import").Cells(i, 5), ".", "/")
Next i

Master.Sheets("Import").Activate
Master.Sheets("Import").Range("A1").CurrentRegion.Sort Key1:=Range("B1"), Order1:=xlAscending, Key2:=Range("E1"), Order2:=xlAscending, Key3:=Range("C1"), Order3:=xlAscending, Header:=xlYes

Arr = Master.Sheets("Import").Range("A1").CurrentRegion

'reset error message
For i = 9 To 30
    For j = 2 To 4
        Master.Sheets("Home").Cells(i, j) = ""
    Next j
Next i
iError = 9

For i = 2 To UBound(Arr, 1)
    EmpCode = Arr(i, 1)
    
    'get saturday of week
    SatWkStart = CDate(Arr(i, 5))
    Do Until Weekday(CDate(SatWkStart), vbMonday) = 6
        SatWkStart = DateAdd("d", -1, SatWkStart)
    Loop
    
    FileName = Replace(SatWkStart, "/", "-")
    
    'create weekly TS
    Set NewTS = Workbooks.Add
    Application.DisplayAlerts = False
    Master.Sheets("Timesheet").Copy After:=NewTS.Sheets(1)
    NewTS.Sheets(1).Delete
    Application.DisplayAlerts = True
    
    'fill in headers
    NewTS.Sheets(1).Cells(2, 3) = Arr(i, 2) 'name
    NewTS.Sheets(1).Cells(2, 7) = DateAdd("d", 6, CDate(SatWkStart)) 'week end friday
    NewTS.Sheets(1).Cells(2, 13) = EmpCode 'ID
    
    'get end of employee
    i2 = i
    Do Until Arr(i2, 1) <> EmpCode Or i2 = UBound(Arr, 1)
        i2 = i2 + 1
    Loop
    If i2 <> UBound(Arr, 1) Then
        LastRow = i2 - 1
    Else
        LastRow = i2
    End If
    
    CNCtr = 0
    
    'for Sat-Fri
    For Ctr = 0 To 6
        Remarks = ""
        'run through whole section and record line by line
        For i2 = i To LastRow
            If CDate(Arr(i2, 5)) = DateAdd("d", Ctr, CDate(SatWkStart)) Then
            
                If Arr(i2, 3) = Arr(i2, 4) Then
                    If UCase(Arr(i2, 3)) = "SICK" Then
                        ContractNo = "S"
                    ElseIf UCase(Arr(i2, 3)) = "HOLIDAY" Then
                        ContractNo = "H"
                    ElseIf UCase(Arr(i2, 3)) = "ABSENT" Then
                        ContractNo = "UA"
                    Else
                        ContractNo = "AA"
                    End If
                Else
                    ContractNo = Arr(i2, 3)
                End If
                
                NewCN = True
                'check if contract no already there
                For Ctr2 = 1 To 6
                    If NewTS.Sheets(1).Cells(4, 2 + (Ctr2 * 2)) = ContractNo Then
                        NewCN = False
                        CNColRef = Ctr2
                    End If
                Next Ctr2
                If NewCN = True Then
                    CNCtr = CNCtr + 1
                    CNColRef = CNCtr
                End If
                x1 = 0
                x15 = 0
                
                If CNCtr > 6 Then
                    'record 7+ contracts error
                    Master.Sheets("Home").Cells(iError, 2) = EmpCode
                    Master.Sheets("Home").Cells(iError, 3) = SatWkStart
                    Master.Sheets("Home").Cells(iError, 2) = ContractNo & " not recorded within timesheet due to there being 6+ codes this week."
                    iError = iError + 1
                Else
                    If NewCN = True Then
                        NewTS.Sheets(1).Cells(4, 2 + (CNColRef * 2)) = ContractNo
                    End If
                    'for each allocated to that contract
                    Continue = True
                    Do Until Continue = False
                        'record hours and rate: night 1.5, w/e 1.5 all else 1.0 unless remarked
                        If Ctr = 0 Or Ctr = 1 Then
                            x15 = x15 + Arr(i2, 6) + Arr(i2, 7)
                        Else
                            x1 = x1 + Arr(i2, 6)
                            x15 = x15 + Arr(i2, 7)
                        End If
                        'record remarks (col I)
                        If Arr(i2, 9) <> "" Then
                            Remarks = Remarks & Arr(i2, 9) & ", "
                        End If
                        
                        i2 = i2 + 1
                        If i2 = LastRow + 1 Then
                            Continue = False
                        ElseIf Arr(i2, 3) <> ContractNo Or CDate(Arr(i2, 5)) <> DateAdd("d", Ctr, CDate(SatWkStart)) Then
                            Continue = False
                        End If
                    Loop
                    
                    'input hours
                    If x1 > 0 Then
                        If x15 > 0 Then
                            NewTS.Sheets(1).Cells(6 + (Ctr * 2), 2 + (CNColRef * 2)) = x1
                            NewTS.Sheets(1).Cells(6 + (Ctr * 2), 2 + (CNColRef * 2) + 1) = 1
                            NewTS.Sheets(1).Cells(6 + (Ctr * 2) + 1, 2 + (CNColRef * 2)) = x15
                            NewTS.Sheets(1).Cells(6 + (Ctr * 2) + 1, 2 + (CNColRef * 2 + 1)) = 1.5
                        Else
                            NewTS.Sheets(1).Cells(6 + (Ctr * 2), 2 + (CNColRef * 2)) = x1
                            NewTS.Sheets(1).Cells(6 + (Ctr * 2), 2 + (CNColRef * 2) + 1) = 1
                        End If
                    ElseIf x15 > 0 Then
                        NewTS.Sheets(1).Cells(6 + (Ctr * 2), 2 + (CNColRef * 2)) = x15
                        NewTS.Sheets(1).Cells(6 + (Ctr * 2), 2 + (CNColRef * 2) + 1) = 1.5
                    End If
                    i2 = i2 - 1
                End If
            End If
        Next i2
        
        'enter remarks
        If Remarks <> "" Then
            NewTS.Sheets(1).Cells(6 + (Ctr * 2), 3) = Left(Remarks, Len(Remarks) - 1)
        End If
        
    Next Ctr
    
    NewTS.SaveAs (SaveFolder & EmpCode & " " & FileName & ".xlsx")
    NewTS.Close
    i = i2 - 1
Next i

Call TurnStuffOn

Master.Sheets("Home").Activate
MsgBox "Success"

End Sub

 

[JBDB]

I changed "String" to "Date" on the variable definition at the top

Incidentally (and possibly related) since then I am now getting an overflow error here:

 

[RoryA]

Just for the variable I mentioned, not for arr, presumably. The error you mention is usually caused by cells being formatted as date that contain large numbers - they would appear as ##### in the cells.

What are the regional settings for the users that have the problem?

 

[JBDB]

Correct, just the SatWkStart type was changed.
Arr was, and remains, a variant type.

I thought that, but the error occurs when setting an array? (which it has done successfully only a few lines before hand).
It has also worked every time now problem for ~6 months until today.

The regional settings within Excel (as far as I'm aware) are the same for problem and "ok" users alike:

Site Settings FYI:

 

[RoryA]

No I meant the windows regional settings. That is what functions like CDate use.

Are there any cells on the sheet that the code is looking at that appear with #### in them? I have never seen an overflow error caused in this circumstance by anything else.

 

[JBDB]

These are my settings (ok user):

There are a problem users settings:

They look the same to me?

Also - yes I do:

Though I am unsure how and why?
When manually correcting those "problem children" I am now getting the date issue too...

 

[RoryA]

I would guess that those cells in column C are formatted as date. That will cause the overflow error you mentioned.

Unless the cells in column E are explicitly left-aligned, the data in rows 11 onwards are text, not dates.

 

[JBDB]

Yeah reformatting those columns as General fixes that side of it.

But the cells in E are aligned differently (from the raw data that's come in), the issue seems to lie here:

When the date column is sorted it swaps months & days (seemingly at random)

 

[RoryA]

Sorting will not change your data. I did mention earlier that if your data where you are replacing the full stops comes through in anything other than mm.dd.yyyy order, your code may alter it when it does the replacement with / if the day number is 12 or less. Where does that data come from?

 

[JBDB]

@RoryA thank you for your help. The solution was as you suggested and quite simple - change the source data.

The issue was happening somewhere between converting the data from "." to an Excel readable date ("/"), and so I cut all that out and the data with correctly formatted dates ran a dream across all users. Thank you.