VBA Date issue question - pleasehelp.

[Mightyginger]

This has been doing my head in for ages now. I've written some code which checks to see if x days from a given date is a valid date (i.e. not a weekend and does not fall on a holiday). (all the code you need is below, just paste in and step through to see the problem I have).

Basically, the date I pass in UK format and yet by some miracle my VBA code then occassionally treats it as US format - all the holdiay dates in the text file are in US format. Basically when it checks the date agaisnt those in the text file it sees dates like these as 08/25/03 in US and 04/09/04 in UK format. Can I instruct VBA which country format to use?

Just use command GingerBumpDates(03/03/2004,2) then answer should be 05/03/04 (all those dates are in UK format)

Function GingerBumpDates(valdate As Date, limit As Integer)
'Attention:
'Beta version.
'There is an error as it doesn't appear to read dates in the textfile such as 01/03/05 properly.
'Need to use it to put date into US code.

Dim num As Integer
Dim code As Variant
Dim year_num As Integer
Dim month_num As Integer
Dim day_num As Integer
Dim i As Integer
Dim Count As Integer
num = 0
code = "eur"

'We are not concerned if today is valid, we are concerned if tomorrow is a valid day
'So move the date onto tomorrow.
year_num = Year(valdate)
month_num = Month(valdate)
day_num = Day(valdate)
valdate = DateSerial(year_num, month_num, day_num + 1)

'Now checking if tomorrow is a valid day.
Do Until num = limit
valdate = QueryTextFile(valdate, 1)
'want to check it's a weekday AFTER checked it's not a holiday
valdate = GingerWeekday(valdate, 1)
'but thenmust check that Monday is also not a holiday as well
valdate = QueryTextFile(valdate, 1)

year_num = Year(valdate)
month_num = Month(valdate)
day_num = Day(valdate)
'So found 1 valid day
num = num + 1

If num < limit Then
valdate = DateSerial(year_num, month_num, day_num + 1)
End If
Loop
GingerBumpDates = valdate

End Function
Function GingerWeekday(inputdate As Date, roll As Integer)
Dim checkyear As Integer
Dim checkmonth As Integer
Dim checkday As Integer
Dim checkweekday As Integer
Dim i As Integer
Dim tempdate As Date

'&quot;roll&quot; has been added so it can roll forward or roll back. Typically use 1 or -1.
'This function takes a given date and returns the next working day.

checkyear = Year(inputdate)
checkmonth = Month(inputdate)
checkday = Day(inputdate)
i = 0

Do Until checkweekday > 1 And checkweekday < 7
tempdate = DateSerial(checkyear, checkmonth, checkday + i)
checkweekday = Weekday(tempdate)
i = i + roll
Loop
GingerWeekday = tempdate
'this function will always return the next working day
End Function


Function QueryTextFile(l_datDate As Date, roll As Integer)

Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim l_sDatabaseFileName As String
Dim i As Integer

'&quot;roll&quot; has been added so it can roll forward or roll back. Typically use 1 or -1.

i = 2
l_sDatabaseFileName = &quot;dates3.txt&quot;


'Create the connection string.
szConnect = &quot;Provider=Microsoft.Jet.OLEDB.4.0;&quot; & _
&quot;Data Source=H:\;&quot; & _
&quot;Extended Properties=Text;&quot;

Do Until i = 0
checkyear = Year(l_datDate)
checkmonth = Month(l_datDate)
checkday = Day(l_datDate)
'So do until it's not a holiday

'Create the SQL statement.
szSQL = &quot;SELECT * FROM &quot; & l_sDatabaseFileName & &quot; WHERE Date = #&quot; & l_datDate & &quot;#;&quot;

Set rsData = New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText

'Check to make sure received data.

If Not rsData.EOF Then
i = 1
l_datDate = DateSerial(checkyear, checkmonth, checkday + 1)
'So it is a holiday date
'Now increase day by 1 and check to see if that is a holiday

Else
i = 0
End If
Loop
'Tidy up.
rsData.Close
Set rsData = Nothing
QueryTextFile = l_datDate

End Function






Contents of textfile dates3.txt saved on H:\ (you may want to change the drive name)


Date
08/27/01
12/25/01
12/26/01
01/01/02
03/29/02
04/01/02
05/06/02
06/03/02
06/04/02
08/26/02
12/25/02
12/26/02
01/01/03
04/18/03
04/21/03
05/05/03
05/26/03
08/25/03
12/25/03
12/26/03
01/01/04
04/09/04
04/12/04
05/03/04
05/31/04
08/30/04
12/27/04
12/28/04
01/03/05
03/25/05
03/28/05
05/02/05
05/30/05
08/29/05
12/26/05
12/27/05
01/02/06
04/14/06
04/17/06
05/01/06
05/29/06
08/28/06
12/25/06
12/26/06
01/01/07
04/06/07
04/09/07
05/07/07
05/28/07
08/27/07
12/25/07
12/26/07
01/01/08
03/21/08
03/24/08
05/05/08
05/26/08
08/25/08
12/25/08
12/26/08
01/01/09
04/10/09
04/13/09
05/04/09
05/25/09
08/31/09
12/25/09
12/28/09
01/01/10
04/02/10
04/05/10
05/03/10
05/31/10
08/30/10
12/27/10
12/28/10
01/03/11
04/22/11
04/25/11
05/02/11
05/30/11
08/29/11
12/26/11
12/27/11
01/02/12
04/06/12
04/09/12
05/07/12
05/28/12
08/27/12
12/25/12
12/26/12
01/01/13
03/29/13
04/01/13
05/06/13
05/27/13
08/26/13
12/25/13
12/26/13
01/01/14
04/18/14
04/21/14
05/05/14
05/26/14
08/25/14
12/25/14
12/26/14
01/01/15
04/03/15
04/06/15
05/04/15
05/25/15
08/31/15
12/25/15
12/28/15
01/01/16
03/25/16
03/28/16
05/02/16
05/30/16
08/29/16
12/26/16
12/27/16
01/02/17
04/14/17
04/17/17
05/01/17
05/29/17
08/28/17
12/25/17
12/26/17
01/01/18
03/30/18
04/02/18
05/07/18
05/28/18
08/27/18
12/25/18
12/26/18
01/01/19
04/19/19
04/22/19
05/06/19
05/27/19
08/26/19
12/25/19
12/26/19
01/01/20
04/10/20
04/13/20
05/04/20
05/25/20
08/31/20
12/25/20
12/28/20
01/01/21
04/02/21
04/05/21
05/03/21
05/31/21
08/30/21
12/27/21
12/28/21
01/03/22
04/15/22
04/18/22
05/02/22
05/30/22
08/29/22
12/26/22

 

[xlbo]

Can you not use date serial numbers ???
Would be easy enought to convert the text file - just open in excel and uise =VALUE(Cell_Ref)
then, in your code, when you pick up a date, convert it to serial number as the 1st thing you do and then search for the serial number..... or is that too simplistic ??

Rgds
Geoff
&quot;Some cause happiness wherever they go; others whenever they go.&quot;
-Oscar Wilde

 

[Mightyginger]

LOL, yes very good. Have made a right hash of it, haven't I? Okay, I won't do quite that but instead what I'll do is to save the text file as excel serial date numbers instead.

Thanks,


Neil.