Sub test()

Dim ClientCode As Variant, Code As Variant

ClientCode = InputBox("Client Code", ClientCode)

Code = mafunction(ClientCode)
Range("A1:F1000") = Code

End Sub

Function mafunction(ByVal client As String) As Variant

Dim internalcode As Long
Dim beginofmonth As Date, endofmonth As Date
Dim startdate As Date, currentdate As Date
Dim todaydate As Date
Dim DateAuthor As Date
Dim i As Long, r As Long
Dim val1 As Variant
Dim var(1 To 1000, 1 To 6) As Variant

todaydate = Date
startdate = DateValue("12/03/2004")
endofmonth = getendofmonth(startdate)

r = 1
i = 0

currentdate = endofmonth


While DateDiff("m", currentdate, todaydate) 0 And r <= 1000

currentdate = getnextday(currentdate)


' If DateDiff("d", beginofmonth, currentdate) < 0 Then

' val1 = CVErr(xlErrNA)
' currentdate = beginofmonth


' End If


internalcode = Int(Rnd() * 1000 + 1)

DateAuthor = Date



var(r, 1) = internalcode

var(r, 2) = currentdate

var(r, 3) = "ROOM"

var(r, 4) = "VACATION"

var(r, 5) = "COMMENTS"

var(r, 6) = DateAuthor

r = r + 1
currentdate = getendofmonth(currentdate)
' currentdate = getnextendofmonth(currentdate)

Wend
mafunction = var
End Function

Public Function getendofmonth(dt As Date) As Date
getendofmonth = DateSerial(Year(dt), Month(dt) + 1, 0)
End Function

Public Function getnextendofmonth(dt As Date) As Date
If dt = DateSerial(Year(dt), Month(dt) + 1, 0) Then
getnextendofmonth = DateSerial(Year(dt), Month(dt) + 1, 0)
Else
getnextendofmonth = DateSerial(Year(dt), Month(dt) + 2, 0)
End If
End Function

Public Function getnextday(dt As Date) As Date
getnextday = dt + 1
End Function



Worked for me.

--
Regards,
Tom Ogilvy



"ina" wrote:

Hello Guys,

I have this function:

Function mafunction(ByVal client As String) as variant


Dim beginofmonth, endofmonth, startdate, currentdate, todaydate,
DateAuthor As Date
Dim i, r As Integer
Dim value As Variant


todaydate = Date
startdate = "12/03/2004"
endofmonth = getendofmonth(startdate)


i = 0

currentdate = endofmonth


While DateDiff("m", currentdate, todaydate) 0

currentdate = getnextday(currentdate)


If DateDiff("d", beginofmonth, currentdate) < 0 Then

value= Evaluate("na()") '
currentdate = beginofmonth

End If


Dim var(1000, 6) As Variant (here I have a problem )

DateAuthor = Date

r = 1

var(r, 0) = internalcode

var(r, 1) = currentdate

var(r, 2) = "ROOM"

var(r, 3) = "VACATION"

var(r, 4) = "COMMENTS"

var(r, 5) = DateAuthor

r = r + 1

currentdate = getnextendofmonth(currentdate)

Wend
mafunction = var ( I have a problem here)
End Function


'I would like to call my fuction from one sub

as

Sub test()

Dim ClientCode, Code As String

ClientCode = InputBox("Client Code", ClientCode)

Code = mafunction (ClientCode)

End Sub

I cannot display the array in my worksheet. I am newbie in vba
programming and I can not figure out where the problem is.

Ina