EmmatheDancer
New Member
- Joined
- Sep 20, 2014
- Messages
- 11
I'm having trouble working out why the code below does not consistently save/open the workbook as the UK date. My computer's regional settings are correct and the date values there are set to DD/MM/YYYY. What is strange is that sometimes it gets the date right and others it doesn't. Is there a way I can make sure the date is always in the format dd.mm.yyyy when saving or searching for the workbook?
Code:
Sub AWOL10()
'
' AWOL10 Macro
'
' Keyboard Shortcut: Ctrl+q
'
TimeMax = Format(TimeValue(Now), "hh:mm")
TimeMin = Format(DateAdd("h", -2, Now), "hh:nn")
Sheets("Abscences").Select
Range("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
Cells.Select
Selection.AutoFilter
ActiveSheet.Range("$A:$H").AutoFilter Field:=7, Criteria1:="Absent"
ActiveSheet.Range("$A:$H").AutoFilter Field:=6, Criteria1:=">=" & TimeMin, Operator:=xlAnd, Criteria2:="<=" & TimeMax
Selection.Copy
Sheets.Add.Name = ("10.30")
Sheets("10.30").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("10.30").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("10.30").Sort.SortFields.Add Key:=Range( _
"A2:A1048451"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("10.30").Sort.SortFields.Add Key:=Range( _
"B2:B1048451"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("10.30").Sort.SortFields.Add Key:=Range( _
"F2:F1048451"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("10.30").Sort
.SetRange Range("A:H")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A:H").Select
Selection.Columns.AutoFit
EffDate = Format(Workbooks("AWOLs & Blanks 2.xlsm").Sheets("10.30").Range("C2").Value, "dd.mm.yyyy")
Dim FilePath As String
Dim TestStr As String
FilePath = "W:\AWOLs\" & EffDate & ".xlsx"
TestStr = ""
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0
If TestStr = "" Then
Workbooks.Add (xlWBATWorksheet)
ActiveWorkbook.SaveAs Filename:="W:\AWOLs\" & EffDate & ".xlsx"
Workbooks("AWOLs & Blanks 2.xlsm").Sheets("10.30").Copy After:=Workbooks(EffDate & ".xlsx").Sheets(Sheets.Count)
TimeNow = Format(TimeValue(Now), "hh.mm")
ActiveSheet.Name = TimeNow
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete
Else
Workbooks.Open ("W:\AWOLs\" & EffDate & ".xlsx")
Workbooks("AWOLs & Blanks 2.xlsm").Sheets("10.30").Copy After:=Workbooks(EffDate & ".xlsx").Sheets(Sheets.Count)
TimeNow = Format(TimeValue(Now), "hh.mm")
ActiveSheet.Name = TimeNow
End If
Workbooks("AWOLs & Blanks 2.xlsm").Sheets("10.30").Cells.Clear
Application.DisplayAlerts = False
Workbooks("AWOLs & Blanks 2.xlsm").Sheets("10.30").Delete
Application.DisplayAlerts = True
Workbooks("AWOLs & Blanks 2.xlsm").Close savechanges:=False
End Sub