sharing macros with other users

[new girl]

Hi. I'm new here and new to my job. I really really need help. I have
macros that need to be put together to run something we call a busines
review. It is set up on one persons computer here. I am trying to ge
it to mine and eventually to a few others. All 3 macros are strun
together to make one macro. I will post the code at the bottom of m
message so maybe someone can tell me what i am doing wrong. PLEAS
HELP!!!!

Thanks in advance

 

[new girl]

Option Explicit

Public Sub Run_Business_Review()

frmBizzReview.Show

End Sub

Public Sub Bold_OG_Descriptions()

frmBold.Show

End Sub
Option Explicit

Public Sub ChangeColumnWidth(strColumnBegin As String, dblWidth A
Double, Optional strColumnEnd As String)

If strColumnEnd = "" Then

Columns(strColumnBegin & ":" & strColumnBegin).Select

Else

Columns(strColumnBegin & ":" & strColumnEnd).Select

End If

Selection.ColumnWidth = dblWidth

End Sub

Public Function GetRowCount(wsSheet As Worksheet, Optional strColumn A
String, Optional intFirstRow As Long) As Long
Dim wsOldSheet As Worksheet
Dim intCurrentRow As Long

Set wsOldSheet = ActiveSheet

wsSheet.Select
If strColumn = "" Then strColumn = "a"
If intFirstRow = 0 Then intFirstRow = 1

intCurrentRow = intFirstRow

Do Until Range(strColumn & intCurrentRow).Value = ""

intCurrentRow = intCurrentRow + 1

Loop

GetRowCount = intCurrentRow - 1

wsOldSheet.Select
Set wsOldSheet = Nothing

End Function
Option Explicit

Private Declare Function GetProfileString Lib "kernel32" Alia
"GetProfileStringA" _
(ByVal lpAppName As String, ByVal lpKeyName As String, _
ByVal lpDefault As String, ByVal lpReturnedString As String, ByVa
nSize As Long) As Long

Public Const hlEnter As Integer = 0
Public Const hlLeave As Integer = 1
Public Const dbStandard As Integer = 1
Public Const dbRemote As Integer = 2

Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Public Sub Highlight(Focus As Integer, xControl As Control)

Select Case Focus
Case Is = hlEnter
xControl.Font.Bold = True
Case Else
xControl.Font.Bold = False
End Select

End Sub

Function dhIsLeapYear(Optional varDate As Variant) As Boolean

' In:
' varDate (Optional):
' If unspecified, use the current year.
' If a date, use the year of the specified date.
' If a valid integer (between 100 and 9999),
' use that value as the year, otherwise use the curren
year.
' If any other dtma type, act as if varDate wasn't specified
' (that is, use the current year).
' Out:
' Return value:
' Boolean indicating whether the specified year
' is a leap year.
' Example:
' If dhIsLeapYear() Then
' ' You know the current year is a leap year.
'
' If dhIsLeapYear(1956) Then
' ' You know 1956 was a leap year.
'
' If dhIsLeapYear(#12/1/92#) Then
' ' You know 1992 was a leap year.

' Missing? Use the current year.
If IsMissing(varDate) Then
varDate = Year(Now)

' Is it a date? Then use that year.
ElseIf VarType(varDate) = vbDate Then
varDate = Year(varDate)

' Is it an integer? Use that value, if it's value.
' Otherwise, use the current year.
ElseIf VarType(varDate) = vbInteger Then
' Only years 100 through 9999 are allowed.
If varDate < 100 Or varDate > 9999 Then
varDate = Year(Now)
End If

' If it's not a date or an integer, just use the
' current year.
Else
varDate = Year(Now)
End If
dhIsLeapYear = (Day(DateSerial(varDate, 2, 28) + 1) = 29)

End Function

Function dhPreviousDOW(intDOW As Integer, Optional dtmDate As Date = 0
As Date
' Find the previous specified day of week before the specifie
date.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' In:
' intDOW:
' The day of the week (vbSunday (1) through
' vbSaturday (7)) to search for.
' dtmDate:
' The starting date.
' Use the current date, if none was specified.
' Out:
' Return Value:
' date representing the prior occurrence of the specified da
of week
' before dtmDate. If dtmDate falls on intDOW, return
dtmDate.
' Example:
' dbFindPreviousdate(#5/1/97#, 1) returns the Sunday prior t
5/1/9
' (that is, 4/27/97).

Dim intTemp As Integer
If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
intTemp = Weekday(dtmDate)
dhPreviousDOW = dtmDate - intTemp + intDOW - IIf(intTemp > intDOW
0, 7)
End Function

Function dhNextDOW(intDOW As Integer, Optional dtmDate As Date = 0) As
Date
' Find the next specified day of week after the specified date.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' In:
' intDOW:
' The day of the week (vbSunday (1) through
' vbSaturday (7)) to search for.
' dtmDate:
' The starting date.
' Use the current date, if none was specified.
' Out:
' Return Value:
' date representing the next occurrence of the specified day
of week
' after dtmDate. If dtmDate falls on intDOW, returns
dtmDate.
' Example:
' dbFindNextdate(#5/1/97#, 1) returns the Sunday after 5/1/9
' (that is, 5/4/97).

Dim intTemp As Integer
If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
intTemp = Weekday(dtmDate)
dhNextDOW = dtmDate - intTemp + intDOW + IIf(intTemp < intDOW, 0,
7)
End Function

Function dhNextAnniversary(dtmDate As Date) As Date
' Given a date, find the next anniversary of that date.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' In:
' dtmDate:
' A date representing a birthdate or anniversary.
' Out:
' Return Value:
' The next occurence of the specified date. If the date
hasn't
' occurred yet this year, return the date within the
' current year. Otherwise, return the date in the next
' year.
' Example:
' If the current date is 11/15/97,
' dhNextAnniversary(#5/16/56#) will return 5/16/98, the
' next time the anniversary occurs.

Dim dtmThisYear As Date

' What's the corresponding date in the current year?
dtmThisYear = DateSerial(Year(Now), Month(dtmDate), Day(dtmDate))

' If the anniversary has already occurred, then add 1 to the year.
If dtmThisYear < Date Then
dtmThisYear = DateAdd("yyyy", 1, dtmThisYear)

 

[new girl]

End If
dhNextAnniversary = dtmThisYear
End Function

Function FirstDayInMonth(Optional dtmDate As Date = 0) As Date
' Return the first day in the specified month.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' In:
' dtmDate:
' The specified date.
' Use the current date, if none was specified.
' Out:
' Return Value:
' The date of the first day in the specified month.
' Example:
' dhFirstDayInMonth(#5/7/70#) returns 5/1/70.

If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
FirstDayInMonth = DateSerial(Year(dtmDate), Month(dtmDate), 1)

End Function

Function LastDayInMonth(Optional dtmDate As Date = 0) As Date
' Return the last day in the specified month.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' In:
' dtmDate:
' The specified date
' Use the current date, if none was specified.
' Out:
' Return Value:
' The date of the last day in the specified month.
' Comments:
' This function counts on odd behavior of dateSerial. That is
each of the
' numeric values can be an expression containing a relativ
value. Here, the
' Day value becomes 1 - 1 (that is, the day before the first da
of the month).
' Example:
' dhLastDayInMonth(#5/7/70#) returns 5/1/70.

If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
LastDayInMonth = DateSerial(Year(dtmDate), Month(dtmDate) + 1, 0)

End Function

Function dhFirstDayInWeek(Optional dtmDate As Date = 0) As Date
' Returns the first day in the week specified by the date i
dtmDate.
' Uses localized settings for the first day of the week.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' In:
' dtmDate:
' date specifying the week in which to work.
' Use the current date, if none was specified.
' Out:
' Return Value:
' First day of the specified week, taking into account the
' user's locale.
' Example:
' dhFirstDayInWeek(#4/1/97#) returns 3/30/97 in the US.

If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
dhFirstDayInWeek = dtmDate - Weekday(dtmDate, vbUseSystem) + 1
End Function

Function dhLastDayInWeek(Optional dtmDate As Date = 0) As Date
' Returns the last day in the week specified by the date i
dtmDate.
' Uses localized settings for the first day of the week.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' In:
' dtmDate:
' date specifying the week in which to work.
' Use the current date, if none was specified.
' Out:
' Return Value:
' Last day of the specified week, taking into account the
' user's locale.
' Example:
' dhLastDayInWeek(#4/1/97#) returns 4/5/97 in the US.

If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
dhLastDayInWeek = dtmDate - Weekday(dtmDate, vbUseSystem) + 7
End Function

Function dhFirstDayInQuarter(Optional dtmDate As Date = 0) As Date
' Returns the first day in the quarter specified by the date i
dtmDate.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' In:
' dtmDate:
' date specifying the quarter in which to work.
' Use the current date, if none was specified.
' Out:
' Return Value:
' First day of the specified quarter.
' Example:
' dhFirstDayInQuarter(#4/15/97#) returns 4/1/97.

Const dhcMonthsInQuarter As Integer = 3

If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
dhFirstDayInQuarter = DateSerial( _
Year(dtmDate), _
Int((Month(dtmDate) - 1) / dhcMonthsInQuarter) _
* dhcMonthsInQuarter + 1, _
1)
End Function

Function dhLastDayInQuarter(Optional dtmDate As Date = 0) As Date
' Returns the last day in the quarter specified by the date in
dtmDate.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' In:
' dtmDate:
' date specifying the quarter in which to work.
' Use the current date, if none was specified.
' Out:
' Return Value:
' Last day of the specified quarter.
' Example:
' dhLastDayInQuarter(#4/1/97#) returns 6/30/97.

Const dhcMonthsInQuarter As Integer = 3

If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
dhLastDayInQuarter = DateSerial( _
Year(dtmDate), _
Int((Month(dtmDate) - 1) / dhcMonthsInQuarter) _
* dhcMonthsInQuarter + (dhcMonthsInQuarter + 1), _
0)
End Function

Function dhFirstDayInYear(Optional dtmDate As Date = 0) As Date
' Return the first day in the specified year.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' In:
' dtmDate:
' The specified date
' Use the current date, if none was specified.
' Out:
' Return Value:
' The date of the first day in the specified year.
' Example:
' dhFirstDayInYear(#5/7/70#) returns 12/31/70.

If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
dhFirstDayInYear = DateSerial(Year(dtmDate), 1, 1)
End Function

Function dhLastDayInYear(Optional dtmDate As Date = 0) As Date
' Return the last day in the specified year.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' In:
' dtmDate (Optional)
' The specified date
' Use the current date, if none was specified.
' Out:
' Return Value:
' The date of the last day in the specified year.
' Example:
' dhLastDayInYear(#5/7/70#) returns 12/31/70.

If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
dhLastDayInYear = DateSerial(Year(dtmDate), 12, 31)

 

[new girl]

End Function

Function dhFirstWorkdayInMonth(Optional dtmDate As Date = 0, _
Optional rst As Recordset = Nothing, Optional strField As String = ""
As Date

' Return the first working day in the month specified.
' If you want to look up holidays in a table, pass in
' a DAO recordset object containing the rows.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' Requires:
' SkipHolidays
' IsWeekend

' In:
' dtmDate:
' date within the month of interest.
' Use the current date, if none was specified.
' rst (Optional):
' Reference to an open dynaset-type recordset containing
' information about the holidays for the year in question.
' If you supply this value, you must also supply
' strField, the name of the field containing dat
information.
' strField (Optional):
' If you supply rst, you must supply this parameter, the
' name of the field in rst containing information about
' the holidays.
' Out:
' Return Value:
' The date of the first working day in the month, taking
' into account weekends and holidays.
' Example:
' ' To find the first working day in 1997, given
' ' a table named tblHolidays in a Jet Database named
' ' Holidays. This table contains a column named date,
' ' containing the Holiday date information.
' Dim db As Database
' Dim rst As Recordset
' Set db = DBEngine.OpenDatabase("Holidays.MDB")
' Set rst = db.OpenRecordset("tblHolidays", DAO.dbOpenDynaset)
' dtmDate = dhFirstWorkdayInMonth(#1/1/97#, rst, "date")

Dim dtmTemp As Date

If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
dtmTemp = DateSerial(Year(dtmDate), Month(dtmDate), 1)
dhFirstWorkdayInMonth = SkipHolidays(rst, strField, dtmTemp, 1)
End Function

Function dhLastWorkdayInMonth(Optional dtmDate As Date = 0, _
Optional rst As Recordset = Nothing, Optional strField As String = ""
As Date

' Return the last working day in the month specified.
' If you want to look up holidays in a table, pass in
' a DAO recordset object containing the rows.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' Requires:
' SkipHolidays
' IsWeekend

' In:
' dtmDate:
' date within the month of interest.
' Use the current date, if none was specified.
' rst (Optional):
' Reference to an open dynaset-type recordset containing
' information about the holidays for the year in question.
' If you supply this value, you must also supply
' strField, the name of the field containing dat
information.
' strField (Optional):
' If you supply rst, you must supply this parameter, the
' name of the field in rst containing information about
' the holidays.
' Out:
' Return Value:
' The date of the last working day in the month, taking
' into account weekends and holidays.
' Example:
' ' To find the last working day in 1997, given
' ' a table named tblHolidays in a Jet Database named
' ' Holidays. This table contains a column named date,
' ' containing the Holiday date information.
' Dim db As Database
' Dim rst As Recordset
' Set db = DBEngine.OpenDatabase("Holidays.MDB")
' Set rst = db.OpenRecordset("tblHolidays", DAO.dbOpenDynaset)
' dtmDate = dhLastWorkdayInMonth(#12/31/97#, rst, "date")

Dim dtmTemp As Date

If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
dtmTemp = DateSerial(Year(dtmDate), Month(dtmDate) + 1, 0)
dhLastWorkdayInMonth = SkipHolidays(rst, strField, dtmTemp, -1)
End Function

Function dhNextWorkday(Optional dtmDate As Date = 0, _
Optional rst As Recordset = Nothing, Optional strField As String = ""
As Date

' Return the next working day after the specified date.
' If you want to look up holidays in a table, pass in
' a DAO recordset object containing the rows.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' Requires:
' SkipHolidays
' IsWeekend

' In:
' dtmDate:
' date on which to start looking.
' Use the current date, if none was specified.
' rst (Optional):
' Reference to an open dynaset-type recordset containing
' information about the holidays for the year in question.
' If you supply this value, you must also supply
' strField, the name of the field containing date
information.
' strField (Optional):
' If you supply rst, you must supply this parameter, the
' name of the field in rst containing information about
' the holidays.
' Out:
' Return Value:
' The date of the next working day, taking
' into account weekends and holidays.
' Example:
' ' Find the next working date after 5/30/97, given
' ' a table named tblHolidays in a Jet Database named
' ' Holidays. This table contains a column named date,
' ' containing the Holiday date information.
' Dim db As Database
' Dim rst As Recordset
' Set db = DBEngine.OpenDatabase("Holidays.MDB")
' Set rst = db.OpenRecordset("tblHolidays", DAO.dbOpenDynaset)
' dtmDate = dhNextWorkday(#5/23/97#, rst, "date")
' ' dtmDate should be 5/27/97, because 5/26/97 is Memorial day.

If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
dhNextWorkday = SkipHolidays(rst, strField, dtmDate + 1, 1)
End Function

Function PreviousWorkday(Optional dtmDate As Date = 0, _
Optional rst As ADODB.Recordset = Nothing, Optional strField As String
= "") As Date

' Return the previous working day before the specified date.
' If you want to look up holidays in a table, pass in
' a DAO recordset object containing the rows.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' Requires:
' SkipHolidays
' IsWeekend

' In:
' dtmDate:
' date on which to start looking.
' Use the current date, if none was specified.
' rst (Optional):
' Reference to an open dynaset-type recordset containing
' information about the holidays for the year in question.
' If you supply this value, you must also supply
' strField, the name of the field containing date
information.
' strField (Optional):
' If you supply rst, you must supply this parameter, the
' name of the field in rst containing information about
' the holidays.
' Out:
' Return Value:
' The date of the previous working day, taking
' into account weekends and holidays.
' Example:
' ' Find the previous working date before 5/27/97, given
' ' a table named tblHolidays in a Jet Database named
' ' Holidays. This table contains a column named date,
' ' containing the Holiday date information.
' Dim db As Database
' Dim rst As Recordset
' Set db = DBEngine.OpenDatabase("Holidays.MDB")
' Set rst = db.OpenRecordset("tblHolidays", DAO.dbOpenDynaset)
' dtmDate = dhPreviousWorkday(#5/27/97#, rst, "date")
' ' dtmDate should be 5/23/97, because 5/26/97 is Memorial day.

If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
PreviousWorkday = SkipHolidays(rst, strField, dtmDate - 1, -1)

End Function

Public Function CountWorkdays(ByVal dtmStart As Date, ByVal dtmEnd As
Date, _
Optional rst As ADODB.Recordset = Nothing, Optional strField As String
= "") _
As Integer

Dim intDays As Integer
Dim dtmTemp As Date
Dim intSubtract As Integer

' Swap the dates if necessary.

 

[new girl]

If dtmEnd < dtmStart Then
dtmTemp = dtmStart
dtmStart = dtmEnd
dtmEnd = dtmTemp
End If

' Get the start and end dates to be weekdays.
dtmStart = SkipHolidays(rst, strField, dtmStart, 1)
dtmEnd = SkipHolidays(rst, strField, dtmEnd, -1)
If dtmStart > dtmEnd Then
' Sorry, no Workdays to be had. Just return 0.
CountWorkdays = 0
Else
intDays = dtmEnd - dtmStart + 1

' Subtract off weekend days. We do this by figuring out ho
many
' calendar weeks there are between the dates, and multiplyin
the
' difference by two (since there are two weekend days for eac
week).
' That is, if the difference is 0, the two days are in the sam
week.
' If the difference is 1, then we have two weekend days.
intSubtract = (DateDiff("ww", dtmStart, dtmEnd) * 2)

' The answer to our quest is all the weekdays, minus any
' holidays found in the table.
' If rst is Nothing, this call won't subtract any dates.
intSubtract = intSubtract + CountHolidays(rst, strField, _
dtmStart, dtmEnd)

CountWorkdays = intDays - intSubtract
End If
End Function

Function dhNthWeekday(dtmDate As Date, intN As Integer, _
intDOW As Integer) As Date

' Find the date of the specified day within the month. For
' example, retrieve the 3rd Tuesday's date.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' In:
' dtmDate:
' Starting date for the search. If this isn't the first
' day of the month, the code moves back to the first.
' intN:
' Number of the specific day, within the month. If larger
' than there are days of the specified type in the month,
' return the date of the requested day anyway. If you as
for
' the 10th Monday, the code will just find the first Monday
' in the specified month, and then add 10 weeks to tha
date.
' intDOW:
' Day of the week to seek.
' Out:
' Return Value:
' The date of the nth specified day after the first day o
the
' the specified month.
' Example:
' dhNthWeekday(#5/5/97#, 3, 3) returns the third Tuesday i
5/97,
' that is, #5/20/97#.

Dim dtmTemp As Date

If (intDOW < vbSunday Or intDOW > vbSaturday) _
Or (intN < 1) Then
' Invalid parameter values. Just
' return the passed-in date.
dhNthWeekday = dtmDate
Exit Function
End If

' Get the first of the month.
dtmTemp = DateSerial(Year(dtmDate), Month(dtmDate), 1)
' Get to the first intDOW in the month.
Do While Weekday(dtmTemp) <> intDOW
dtmTemp = dtmTemp + 1
Loop
' Now you've found the first intDOW in the month.
' Just add 7 for each intN after that.
dhNthWeekday = dtmTemp + ((intN - 1) * 7)
End Function

Public Function CountHolidays(rst As ADODB.Recordset, strField A
String, _
dtmStart As Date, datend As Date) As Integer

' Count holidays between two end dates.
'
' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' Required by:
' dhCountWorkdays

Dim strFilter As String
Dim strOldFilter As String
Dim intRows As Integer

On Error GoTo HandleErr
If Not rst Is Nothing Then
If Len(strField) > 0 Then
If Left(strField, 1) <> "[" Then
strField = "[" & strField & "]"
End If
strFilter = strField & " >= #" & Format$(dtmStart
"mm/dd/yyyy") & "# AND " & strField & "<= #" & Format$(datend
"mm/dd/yyyy") & "#"
rst.Filter = strFilter
If Not rst.EOF Then
rst.MoveLast
intRows = rst.RecordCount
End If
End If
End If

ExitHere:
CountHolidays = intRows
Exit Function

HandleErr:
' No matter what the error, just
' return without complaining.
' The worst that could happen is that the code
' include a holiday as a real day, even if
' it's in the table.
Resume ExitHere
End Function

Private Function SkipHolidays(rst As ADODB.Recordset, _
strField As String, dtmTemp As Date, intIncrement As Integer) As Date
' Skip weekend days, and holidays in the recordset referred to b
rst.
' Return dtmTemp + as many days as it takes to get to a day that'
not
' a holiday or weekend.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' Required by:
' dhFirstWorkdayInMonth
' dbLastWorkdayInMonth
' dhNextWorkday
' dhPreviousWorkday
' dhCountWorkdays

Dim strCriteria As String
On Error GoTo HandleErr

' Move up to the first Monday/last Friday, if the first/last
' of the month was a weekend date. Then skip holidays.
' Repeat this entire process until you get to a weekday.
' Unless rst contains a row for every day in the year (!)
' this should finally converge on a weekday.
Do

Do While IsWeekend(dtmTemp)

dtmTemp = dtmTemp + intIncrement

Loop

If Not rst Is Nothing Then

If Len(strField) > 0 Then

If Left(strField, 1) <> "[" Then

strField = "[" & strField & "]"

End If

Do

strCriteria = strField & " = #" & Format(dtmTemp,
"mm/dd/yy") & "#"
rst.Filter = strCriteria

If Not rst.EOF Then

dtmTemp = dtmTemp + intIncrement

End If

Loop Until rst.EOF

End If

End If

Loop Until Not IsWeekend(dtmTemp)

ExitHere:
SkipHolidays = dtmTemp
Exit Function

HandleErr:
' No matter what the error, just
' return without complaining.
' The worst that could happen is that we
' include a holiday as a real day, even if
' it's in the table.
Resume ExitHere
End Function

Private Function IsWeekend(dtmTemp As Date) As Boolean
' If your weekends aren't Saturday (day 7) and Sunday (day 1),
' change this routine to return True for whatever days
' you DO treat as weekend days.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' Required by:
' SkipHolidays
' dhFirstWorkdayInMonth
' dbLastWorkdayInMonth
' dhNextWorkday
' dhPreviousWorkday
' dhCountWorkdays

Select Case Weekday(dtmTemp)
Case vbSaturday, vbSunday
IsWeekend = True
Case Else
IsWeekend = False
End Select
End Function

Function dhCNumdate(ByVal lngdate As Long, _
ByVal strFormat As String) As Variant
' Convert numbers to dates, depending on the specified format
' and the incoming number. In this case, the number and the
' format must match, or the output will be useless.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' In:
' lngdate:
' Number representing the date to be returned. Because
numbers don't
' have leading 0's, that sitation will never occur.
' strFormat:
' String expression containing the format of the value in
lngdate.
' Must be one of the following:
' "MMDDYY"'
' "MMDDYYYY"
' "DDMMYY"
' "DDMMYYYY"
' "YYMMDD"
' "YYYYMMDD"
' Out:
' The value in lngdate, converted to a date, given the format
specified
' in strFormat.
' Example:
' dhCNumdate(19560516, "YYYYMMDD") will return the date 5/16/56.
' dhCNumdate(51656, "MMDDYY") will return the date 5/16/56
' dhCNumdate(51620, "MMDDYY") will return the date 5/16/2020

Dim intYear As Integer
Dim intMonth As Integer
Dim intDay As Integer
Dim fOk As Boolean

fOk = True
Select Case strFormat
Case "MMDDYY"
intYear = lngdate Mod 100
intMonth = lngdate \ 10000
intDay = (lngdate \ 100) Mod 100

Case "MMDDYYYY"
intYear = lngdate Mod 10000
intMonth = lngdate \ 1000000
intDay = (lngdate \ 10000) Mod 100

Case "DDMMYY"
intYear = lngdate Mod 100
intMonth = (lngdate \ 100) Mod 100
intDay = lngdate \ 10000

 

[new girl]

Case "DDMMYYYY"
intYear = lngdate Mod 10000
intMonth = (lngdate \ 10000) Mod 100
intDay = lngdate \ 1000000

Case "YYMMDD", "YYYYMMDD"
intYear = lngdate \ 10000
intMonth = (lngdate \ 100) Mod 100
intDay = lngdate Mod 100

Case Else
fOk = False
End Select
If fOk Then
dhCNumdate = DateSerial(intYear, intMonth, intDay)
Else
dhCNumdate = Null
End If
End Function

Function dhCStrdate(strDate As String, Optional strFormat As String
"") As Date

' Given a string containing a date value, and a format
' string describing the information in the date string,
' convert the string into a real date value.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' In:
' strDate:
' String expression containing a date to be converted.
' strFormat (Optional):
' String expression containing a format specifier for the
' string in strdate. If omitted, the function uses "", which
' will cause it to use the Cdate function to attempt to
' conversion, just as it will if any other unknown format
' string is passed in.
'
' Allowable formats:
' "MMDDYY", "MMDDYYYY"
' "DDMMYY", "DDMMYYYY"
' "YYMMDD", "YYYYMMDD"
' "DD/MM/YY", "DD/MM/YYYY" ("/" stands for any delimite
in the date string)
' "YY/MM/DD", "YYYY/MM/DD"
' Out:
' Return Value:
' The value in strDate, converted to a date, if possible.
' Example:
' dhCStrdate("59/04/22", "YY/MM/DD") returns the real dat
#4/22/59#
'
Dim strYear As String
Dim strMonth As String
Dim strDay As String
Dim fDone As Boolean

Select Case strFormat
Case "MMDDYY", "MMDDYYYY"
strYear = Mid(strDate, 5)
strMonth = Left(strDate, 2)
strDay = Mid(strDate, 3, 2)

Case "DDMMYY", "DDMMYYYY"
strYear = Mid(strDate, 5)
strMonth = Mid(strDate, 3, 2)
strDay = Left(strDate, 2)

Case "YYMMDD"
strYear = Left(strDate, 2)
strMonth = Mid(strDate, 3, 2)
strDay = Right(strDate, 2)

Case "YYYYMMDD"
strYear = Left(strDate, 4)
strMonth = Mid(strDate, 5, 2)
strDay = Right(strDate, 2)

Case "DD/MM/YY", "DD/MM/YYYY"
strYear = Mid(strDate, 7)
strMonth = Mid(strDate, 4, 2)
strDay = Left(strDate, 2)

Case "YY/MM/DD"
strYear = Left(strDate, 2)
strMonth = Mid(strDate, 4, 2)
strDay = Right(strDate, 2)

Case "YYYY/MM/DD"
strYear = Left(strDate, 4)
strMonth = Mid(strDate, 6, 2)
strDay = Right(strDate, 2)

Case Else
' If none of the other formats were matched, just count o
Cdate
' to do the conversion. It may fail, but we can't help ou
here.
dhCStrdate = CDate(strDate)
fDone = True
End Select
If Not fDone Then
dhCStrdate = DateSerial(Val(strYear), Val(strMonth)
Val(strDay))
End If
End Function

Function DaysInMonth(Optional dtmDate As Date = 0) As Integer

If dtmDate = 0 Then

dtmDate = Date

End If

DaysInMonth = DateSerial(Year(dtmDate), Month(dtmDate) + 1, 1) - _
DateSerial(Year(dtmDate), Month(dtmDate), 1)

End Function

Function dhCountDOWInMonth(ByVal dtmDate As Date, _
Optional intDOW As Integer = 0) As Integer

' Calculate the number of specified days in
' the specified month.
'
' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.
'
' In:
' dtmDate:
' date value specifying the month and year
' If intDOW is missing, this date also
' supplies the day of week to count.
' intDOW: (Optional)
' If supplied, contains the day of week
' (vbSunday (1) - vbSaturday (7)) to be
' counted within the specified month/year.
' If not supplied, the function uses the
' day of week of the required date parameter.
' Out:
' Return value:
' The number of days matching intDOW (or dtmDate)
' in the specified month/year.
'
' Example:
' dhCountDOWInMonth(#11/96#, 6) returns 5
' (there were 5 Fridays in November 1996)
' dhCountDOWInMonth(#11/3/96#) returns 4
' (11/3/96 was a Sunday, and there were 4 Sundays in th
month)
' dhCountDOWInMonth(#11/3/96#, 6) returns 5
' (the intDOW parameter overrides the day portion of the
date)

Dim dtmFirst As Date
Dim intCount As Integer
Dim intMonth As Integer

If (intDOW < vbSunday Or intDOW > vbSaturday) Then
' Caller must not have specified DOW, or it
' was an invalid number.
intDOW = Weekday(dtmDate)
End If
intMonth = Month(dtmDate)

' Find the first day of the month
dtmFirst = DateSerial(Year(dtmDate), intMonth, 1)

' Move dtmFirst forward until it hits the
' matching day number.
Do While Weekday(dtmFirst) <> intDOW
dtmFirst = dtmFirst + 1
Loop

' Now, dtmFirst is sitting on the first day
' of the requested number in the month. Just count
' how many of that day type there are in the month.
intCount = 0
Do While Month(dtmFirst) = intMonth
intCount = intCount + 1
dtmFirst = dtmFirst + 7
Loop
dhCountDOWInMonth = intCount
End Function


Function dhAgeUnused(dtmBD As Date, Optional dtmDate As Date = 0) _
As Integer

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

Dim intAge As Integer

If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
intAge = DateDiff("yyyy", dtmBD, dtmDate)
If dtmDate < DateSerial(Year(dtmDate), Month(dtmBD), Day(dtmBD))
Then
intAge = intAge - 1
End If
dhAgeUnused = intAge
End Function

Function dhAge(dtmBD As Date, Optional dtmDate As Date = 0) As Integer
' Calculate a person's age, given their birthdate and
' an optional "current" date.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' In:
' dtmBD:
' The birthdate (or any other anniversary date)
' dtmDate:
' The reference date. If omitted, the code uses today's
' date.
' Out:
' Return Value:
' The number of fulls years between dtmBD and dtmDate.
' Example:
' dhAge(#5/22/59#, #1/1/97#) returns 37, since the anniversary
' hasn't passed yet (dateDiff would return 38).

If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
dhAge = DateDiff("yyyy", dtmBD, dtmDate) + _
(dtmDate < DateSerial(Year(dtmDate), Month(dtmBD), Day(dtmBD)))
End Function

Function dhFormatInterval(dtmStart As Date, datend As Date, _
Optional strFormat As String = "H:MM:SS") As String
' Return the difference between two times,
' formatted as specified in strFormat.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' Requires:
' GetTimeDelimiter

' In:
' dtmStart:
' starting date for the interval, including a time portion
' datend:
' ending date for the interval, including a time portion
' strFormat (optional):
' format specifier, as shown below. (Default: "H:MM:SS")
' Out:
' Return Value:
' The formatted time difference.
' Comment:
' Due to the way the calculations are performed, the largest
interval
' is 68 years or so.
' Example:
' Using #1/1/97 12:00 PM# and #1/4/97 2:45:45 PM# as the dates,
and one
' of the following format templates,
' dhFormatInterval(#1/1/97 12:00 PM#, #1/4/97 2:45:45 PM#,
"<format>")
' will return (using each of the following format strings):
' D H 3 Days 3 Hours
' D H M 3 Days 2 Hours 46 Minutes
' D H M S 3 Days 2 Hours 45 Minutes 45 Seconds
' D H:MM 3 Days 2:46
' D HH:MM 3 Days 02:46
' D HH:MM:SS 3 Days 02:45:45

' H M 74 Hours 46 Minutes
' H:MM 74:46 (leading 0 on minutes, if necessary)
' H:MM:SS 74:45:45

' M S 4485 Minutes 45 Seconds
' M:SS 4485:45 (leading 0 on seconds, if
necessary)

Dim lngSeconds As Long

 

[new girl]

Dim sngMinutes As Single
Dim sngHours As Single
Dim sngDays As Single

Dim intSeconds As Integer
Dim intMinutes As Integer
Dim intHours As Integer

Dim intRoundedHours As Integer
Dim intRoundedMinutes As Integer

Dim strDay As String
Dim strHour As String
Dim strMinute As String
Dim strSecond As String
Dim strOut As String

Dim lngFullDays As Long
Dim lngFullHours As Long
Dim lngFullMinutes As Long

Dim strDelim As String

' If you don't want to use the local delimiter,
' but a specific one, replace the next line with
' this:
' strDelim = ":"
strDelim = GetTimeDelimiter()

' Calculate the full number of seconds in the interval.
' This limits the calculation to 2 billion seconds (68 years
' or so), but that's not too bad. Then calculate the
' difference in minutes, hours, and days, as well.
lngSeconds = DateDiff("s", dtmStart, datend)
sngMinutes = lngSeconds / 60
sngHours = sngMinutes / 60
sngDays = sngHours / 24

' Get the full hours and minutes, for later display.
lngFullDays = Int(sngDays)
lngFullHours = Int(sngHours)
lngFullMinutes = Int(sngMinutes)

' Get the incremental amount of each unit.
intHours = Int((sngDays - lngFullDays) * 24)
intMinutes = Int((sngHours - lngFullHours) * 60)
intSeconds = CInt((sngMinutes - lngFullMinutes) * 60)

' In some instances, time values must be rounded.
' The next two lines depend on the fact that a true statement
' has a value of -1, and a false statement has a value of 0.
' The code needs to add 1 to the value if the following expression
' is true, and 0 if not.
intRoundedHours = intHours - (intMinutes > 30)
intRoundedMinutes = intMinutes - (intSeconds > 30)

strDay = "Days"
strHour = "Hours"
strMinute = "Minutes"
strSecond = "Seconds"

If lngFullDays = 1 Then strDay = "Day"
Select Case strFormat
Case "D H"
If intRoundedHours = 1 Then strHour = "Hour"
strOut = lngFullDays & " " & strDay & " " & _
intRoundedHours & " " & strHour
Case "D H M"
If intHours = 1 Then strHour = "Hour"
If intRoundedMinutes = 1 Then strMinute = "Minute"
strOut = lngFullDays & " " & strDay & " " & _
intHours & " " & strHour & " " & _
intRoundedMinutes & " " & strMinute
Case "D H M S"
If intHours = 1 Then strHour = "Hour"
If intMinutes = 1 Then strMinute = "Minute"
If intSeconds = 1 Then strSecond = "Second"
strOut = lngFullDays & " " & strDay & " " & _
intHours & " " & strHour & " " & _
intMinutes & " " & strMinute & " " & _
intSeconds & " " & strSecond

Case "D H:MM" ' 3 Days 2:46"
strOut = lngFullDays & " " & strDay & " " & _
intHours & strDelim & Format(intRoundedMinutes, "00")
Case "D HH:MM" ' 3 Days 02:46"
strOut = lngFullDays & " " & strDay & " " & _
Format(intHours, "00") & strDelim & _
Format(intRoundedMinutes, "00")
Case "D HH:MM:SS" ' 3 Days 02:45:45"
strOut = lngFullDays & " " & strDay & " " & _
Format(intHours, "00") & strDelim & _
Format(intMinutes, "00") & strDelim & _
Format(intSeconds, "00")

Case "H M" ' 74 Hours 46 Minutes"
If lngFullHours = 1 Then strHour = "Hour"
If intRoundedMinutes = 1 Then strMinute = "Minute"
strOut = lngFullHours & " " & strHour & " " & _
intRoundedMinutes & " " & strMinute
Case "H:MM" ' 74:46 (leading 0 on minutes, i
necessary)
strOut = lngFullHours & strDelim
Format(intRoundedMinutes, "00")
Case "H:MM:SS" ' 74:45:45"
strOut = lngFullHours & strDelim & _
Format(intMinutes, "00") & strDelim & _
Format(intSeconds, "00")

Case "M S" ' 4485 Minutes 45 Seconds
If lngFullMinutes = 1 Then strMinute = "Minute"
If intSeconds = 1 Then strSecond = "Second"
strOut = lngFullMinutes & " " & strMinute & " " & _
intSeconds & " " & strSecond
Case "M:SS" ' 4485:45 (leading 0 on seconds, i
necessary)"
strOut = lngFullMinutes & strDelim & _
Format(intSeconds, "00")

Case Else
strOut = ""
End Select
dhFormatInterval = strOut
End Function

Private Sub TestInterval()
Dim dtmStart As Date
Dim dtmEnd As Date

dtmStart = #1/1/1997 12:00:00 PM#
dtmEnd = #1/4/1997 2:45:45 PM#

Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D H")
Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D H M")
Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D H M S")
Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D H:MM")
Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D HH:MM")
Debug.Print dhFormatInterval(dtmStart, dtmEnd, "D HH:MM:SS")

Debug.Print dhFormatInterval(dtmStart, dtmEnd, "H M")
Debug.Print dhFormatInterval(dtmStart, dtmEnd, "H:MM")
Debug.Print dhFormatInterval(dtmStart, dtmEnd, "H:MM:SS")

Debug.Print dhFormatInterval(dtmStart, dtmEnd, "M S")
Debug.Print dhFormatInterval(dtmStart, dtmEnd, "M:SS")

End Sub

Function dhCMinutes(dtmTime As Date) As Long
' Convert a date/time value to the number of
' minutes since midnight (that is, remove the date
' portion, and just work with the time part.) The
' return value can be used to calculate sums of
' elapsed time.

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' In:
' dtmTime:
' A date/time value
' Out:
' Return Value:
' Time portion of the input value, converted to minutes.

' Subtract off the whole portion of the date/time value
' and then convert from a fraction of a day to minutes.
dhCMinutes = TimeValue(dtmTime) * 24 * 60
End Function

Function dhCTimeStr(lngMinutes As Long) As String
' Convert from a number of minutes to a string
' that looks like a time value.
' This function is not aware of international settings.
'
' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' Requires:
' GetTimeDelimiter

' In:
' lngMinutes:
' A quantity of minutes to be converted to an h:mm string
' Out:
' Return Value:
' The number of minutes, converted to h:mm format.

dhCTimeStr = Format(lngMinutes \ 60, "0") & _
GetTimeDelimiter() & Format(lngMinutes Mod 60, "00")
End Function

Private Function GetTimeDelimiter() As String
' Retrieve the time delimiter from, believe it or not,
' WIN.INI. This is the only reasonable solution
' to this problem, even in this day and age!

' Used by:
' dhCTimeStr
' dhFormatInterval

' Requires:
' GetProfileString declaration

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

Const conMaxSize = 10
Dim strBuffer As String
Dim intLen As Integer

strBuffer = Space(conMaxSize)
intLen = GetProfileString("intl", "sTime", "", strBuffer,
conMaxSize)
GetTimeDelimiter = Left(strBuffer, intLen)
End Function

Function dhRoundTime(dtmTime As Date, intInterval As Integer) As Date

' Round the time value in varTime to the nearest minute
' interval in intInterval

' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' In:
' dtmTime:
' The original time
' intInterval:
' Interval to which to round dtmTime, in minutes.
' Must be a divisor of 60 (2, 3, 4, 5, 6, 10, 12, 15,
' 20, 30, or 60)
' Out:
' Return Value:
' The rounded time, to the nearest increment of intInterval.
' Example:
' dhRoundTime(#3/5/97 11:08 AM#, 15) returns
' #3/5/97 11:15:00 AM#

Dim sglTime As Single
Dim intHour As Integer
Dim intMinute As Integer
Dim lngdate As Long

' Get the date portion of the date/time value
lngdate = DateValue(dtmTime)

' Get the time portion as a number like 11.5 for 11:30.
sglTime = TimeValue(dtmTime) * 24

' Get the hour and store it away. Int truncates,
' CInt rounds, so use Int.
intHour = Int(sglTime)

' Get the number of minutes, and then round to the nearest
' occurrence of the interval specified.
intMinute = CInt((sglTime - intHour) * 60)
intMinute = CInt(intMinute / intInterval) * intInterval

' Build back up the original date/time value,
' rounded to the nearest interval.
dhRoundTime = CDate(lngdate + _
((intHour + intMinute / 60) / 24))
End Function

Public Function ExtractSetting(strSetting As String, strSubject As
String) As Variant
Dim intFirstChar As Long
Dim intLastChar As Long

intFirstChar = InStr(1, strSubject, strSetting, vbTextCompare)

If intFirstChar = 0 Then

ExtractSetting = 0

Else

intFirstChar = intFirstChar + Len(strSetting) + 1
intLastChar = intFirstChar

 

[new girl]

Do Until Mid$(strSubject, intLastChar, 1) = ";" Or intLastChar
Len(strSubject)

intLastChar = intLastChar + 1

Loop

ExtractSetting = Mid$(strSubject, intFirstChar, intLastChar
intFirstChar)

End If

End Function

Public Sub vAlpha(KeyAscii As Integer)
Dim intTemp As Integer

intTemp = Asc(UCase(Chr(KeyAscii)))

If (intTemp < Asc("A") Or intTemp > Asc("Z")) _
And intTemp <> Asc(" ") _
And intTemp <> Asc("-") _
And intTemp <> 8 Then

KeyAscii = 0

End If

End Sub

Public Sub vNumeric(KeyAscii As Integer)

If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) _
And KeyAscii <> 8 Then

KeyAscii = 0

End If

End Sub

Public Sub vAlphaNumeric(KeyAscii As Integer)

If (KeyAscii < Asc("A") Or KeyAscii > Asc("Z")) And _
(KeyAscii < Asc("a") Or KeyAscii > Asc("z")) And _
(KeyAscii < Asc("0") Or KeyAscii > ("9")) _
And KeyAscii <> Asc(" ") _
And KeyAscii <> Asc("-") _
And KeyAscii <> 8 Then

KeyAscii = 0

End If

End Sub

Public Function xlGetRowCount(wsSheet As Worksheet, Optional strColum
As String = "A", Optional intFirstRow As Long = 1) As Long
Dim intCurrentRow As Long

If strColumn = "" Then strColumn = "a"
If intFirstRow = 0 Then intFirstRow = 1

intCurrentRow = intFirstRow

Do Until wsSheet.Range(strColumn & intCurrentRow).Value = ""

intCurrentRow = intCurrentRow + 1

Loop

xlGetRowCount = intCurrentRow - 1

End Function

Public Function Lengthen(strText As String, bytLength As Byte, Optiona
AddToLeft As Boolean = False) As String

If Len(strText) <> bytLength Then

If Not AddToLeft Then

Lengthen = strText & Space(bytLength - Len(strText))

Else

Lengthen = Space(bytLength - Len(strText)) & strText

End If

Else

Lengthen = strText

End If

End Function

Public Function NZ(varData As Variant) As Currency

If IsNull(varData) Then

NZ = 0

Else

NZ = varData

End If

End Function

Public Function ConvertMonthStringToFiscalMonthNumber(Month As String
As Integer
Dim intMonth As Integer

intMonth = CInt(Format(CDate(Month & " 1, 2000"), "mm")) - 3
If intMonth < 1 Then intMonth = intMonth + 12
ConvertMonthStringToFiscalMonthNumber = intMonth

End Function

Public Function ConvertFiscalMonthNumberToMonthString(ByVal Month A
Integer) As String
Dim intTemp As Date

Month = Month + 3
If Month > 12 Then Month = Month - 12
intTemp = CDate(Month & "/1/2000")
ConvertFiscalMonthNumberToMonthString = Format$(intTemp, "mmmm")

End Function

Public Function RemoveSpaces(strText As String) As String
Dim strInterm As String
Dim lngPos As Long

strInterm = Trim(strText)

If Len(strInterm) > 0 Then

lngPos = InStr(1, strInterm, " ")

Do Until lngPos = 0

strInterm = Left(strInterm, lngPos - 1) & Right(strInterm
Len(strInterm) - lngPos)
lngPos = InStr(1, strInterm, " ")

Loop

End If

RemoveSpaces = strInterm

End Function

Public Sub GetHolidays(cnnMain As ADODB.Connection, rstHolidays A
ADODB.Recordset)

OpenMaintained cnnMain, adModeRead

Set rstHolidays = Nothing
Set rstHolidays = New ADODB.Recordset

With rstHolidays

.ActiveConnection = cnnMain
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Source = "[Holidays]"
.Open , , , , adCmdTable

End With

End Su

 

[new girl]

first, i really hope i didn't offend anyone by posting all of this!

next, what i posted previously are 3 different macros made to all flo
together as one. does anyone have any ideas as to how i go about this?

please please please

 

[new girl]

i am willing to pay pal/send check for your help if it works

 

[new girl]

anyone?

 

[GDuffield]

are these macros to be accessed within the same excel file ? have yo
tried storing them within the actual file they are needed within....

 

[new girl]

no. i'm not really sure what to do with them or how to go about it.

:

 

[new girl]

any help/ips/ideas would be *greatly* appreciate

 

[DataMan]

I am not an expert at this but if these macros are all in one Exce
workbook you can copy it to your machine and have it open when you nee
to run it on another file.

You can also put the file in your "XLStart" folder if you want to hav
it open up every time you open Excel. This folder is usually i
"Documents and Settings\YourUsername\Applicatio
Data\Microsoft\Excel\XLSTART"

There is also probably a way that you can copy all macros into a ne
VBA module and have all of it run at once. Lengthy to explain for m
though. I am just learning this stuff myself

 

[Mark_K]

Have you found a solution to this problem yet