Is there a better way?

[CJ_London]

You should know which columns those dates are populating - presumable columns 5 and 10?
By the same token you should know which worksheet based on the month number
- May would presumably be the 5th sheet?

will get more complicated if the leave is spread over a month end

 

[Isaac]

There are a few ways you could approach this, you can write an array containing the days 5th through 10th and then use the find method to find which column has those numbers, or you could write a loop to loop through all of them just whichever is easiest for you

 

[Gasman]

Would be the column number that matches the date for that day, surely?

 

[Valentine]

so I have NO CLUE how to do the things y'all have stated. So far in my coding I have done easy stuff. Looping would probably be the best but how do I set up the parameters so when it goes down the list in the RS that it puts the leave in the right place?

 

[CJ_London]

not sure this would be the exact syntax but something like

dim rownum as integer
dim i as integer
dim rs as dao.recordset

set rs=currentdb.openrecordset(".....") 'whatever you are looping through you which contains the leave details
rownum=1 'change this value to whatever number or rows you have in the header
while not rs.eof
    rownum=rownum+1
    for i=0 to datediff("d",rs!startdate,rs!enddate)
       Worksheets(month(rs!startdate)).cells(rownum,rs!startdate+i).backcolor=vbgreen
    next i

    rs.movenext

wend

where rs!startdate and rs!enddate are those for the leave dates

 

[Valentine]

not sure this would be the exact syntax but something like

dim rownum as integer
dim i as integer
dim rs as dao.recordset

set rs=currentdb.openrecordset(".....") 'whatever you are looping through you which contains the leave details
rownum=1 'change this value to whatever number or rows you have in the header
while not rs.eof
    rownum=rownum+1
    for i=0 to datediff("d",rs!startdate,rs!enddate)
       Worksheets(month(rs!startdate)).cells(rownum,rs!startdate+i).backcolor=vbgreen
    next i

    rs.movenext

wend

where rs!startdate and rs!enddate are those for the leave dates

quick question before I start. your rownum variable thats each column correct? the dates start at the 4th column.

 

[CJ_London]

I'm assuming you have dates across the top and employees down the side. So assuming your query has the same order as whatever you used to populate the worksheet in the first place and the first name is on the second row as you iterate through the recordset, the rownum increments by 1.

So no, rownum is nothing to do with the column, it's to do with the row

 

[Valentine]

Oh makes sense now thank you, I will attempt to do this this week.

 

[Valentine]

I am getting "Object doesn't support this property or method"

    rownum = 1
    While Not rsLeave.EOF
        rownum = rownum + 1
        For i = 0 To DateDiff("d", rsLeave![Start Date], rsLeave![End Date])
            wsNew(Month(rsLeave![Start Date])).cells(rownum, rsLeave![Start Date] + 1).BackColor = vbGreen
        Next i
        rsLeave.MoveNext
    Wend

not sure if its the .cells or the .backcolor that is causing the issue.

 

[CJ_London]

what line generates the error

you do have one typo

I said
cells(rownum,rs!startdate+i).backcolor

you've used
cells(rownum, rsLeave![Start Date] + 1).BackColor

 

[Valentine]

Made that change, still same error.

wsNew(Month(rsLeave![Start Date])).cells(rownum, rsLeave![Start Date] + i).BackColor = vbGreen

thats the line that is highlighted.

 

[CJ_London]

Also need to check that wsNew(Month(rsLeave![Start Date])) is referencing as required - i.e. are your worksheets just given a number from 1 to 12?

you can also check by pausing on that line then in the immediate window type

?wsNew(Month(rsLeave![Start Date])).

do the same for rsLeave![Start Date] and rownum


then see what the intellisense brings up after the dot.

also suggest in excel, record a macro to set a colour to 3 or 4 cells horizontally and compare with the code I provided.

and have just noticed that you also need to use the day function - my bad

cells(rownum, day(rsLeave![Start Date]) + i)

 

[Valentine]

intellisense doesn't pop up at either decimal.

All of the worksheets are named by their respected month not a number.
I also tried to replace .backcolor with .interior.colorindex and still got the same error.

 

[CJ_London]

All of the worksheets are named by their respected month not a number.

so you need to step through the code and check values are as required. for the month name you need

monthname(month(rsLeave![Start Date]))

with respect, I'm not going to spend my time guessing what the problem may be. I gave my assumptions for the code, seems you have not taken them into account.

Have you tried recording a macro as I suggested?

 

[Isaac]

What is this supposed to be ?? This isn't a valid syntax for any property or method:

wsNew(Month(

Think about it. Month() will return something like 6.

Is wsNew(6) ... anything valid?

CJ suggested Worksheets(Month), and you used wsNew(months).

Why?

 

[Valentine]

Macro has .themeColor = xlThemeColorAccent6 for green

I used wsNew (Month) instead of worksheets(month) because wsNew is what I have set as worksheets in the VBA code.

I dont know what more to put in here to help the experts help me.

    rownum = 1
    While Not rsLeave.EOF
        rownum = rownum + 1
        For i = 0 To DateDiff("d", rsLeave![Start Date], rsLeave![End Date])
            wsNew(MonthName(rsLeave![Start Date])).cells(rownum, Day(rsLeave![Start Date] + i)).BackColor = 4
            'wsNew(Month(rsLeave![Start Date])).cells(rownum, Day(rsLeave![Start Date] + i)).BackColor = 4
            'wsNew(Month(rsLeave![Start Date])).cells(rownum, Day(rsLeave![Start Date] + i)).Interior.ColorIndex = 4
        Next i
        rsLeave.MoveNext
    Wend

I have tried fitting that bit into the case select fields that break up the workbook into the individual months.

 Select Case wsNew.Name
            Case "January", "March", "May", "July", "August", "October", "December"
                wsNew.Range("D2:E2").Autofill Destination:=wsNew.Range("D2:AH2"), Type:=xlFillSeries
                With wsNew.Range("D1", "AH1")
                    .Font.Bold = True
                    .Font.Size = 12
                    .VerticalAlignment = xlVAlignCenter
                    .HorizontalAlignment = xlVAlignCenter
                    .MergeCells = True
                    If wsNew.Name = "January" Then
                        .Value = "January"
                        wsNew.cells(3, 4).Value = "Saturday"
                        wsNew.Range("D3").Autofill Destination:=wsNew.Range("D3:AH3"), Type:=xlFillWeekdays
                        With wsNew.Range("D3", "AH3")
                            .HorizontalAlignment = xlVAlignCenter
                        End With

I am just missing the step to bring in the days from rsLeave into the excel document and shade them.

 

[CJ_London]

I dont know what more to put in here to help the experts help me.

provide the whole code related to what you are trying to do and include comments within the code (which you should be doing anyway) so we know what it is supposed to do, not just bits. For example you say

I used wsNew (Month) instead of worksheets(month) because wsNew is what I have set as worksheets in the VBA code.

perhaps you have, perhaps you haven't but it will reassure us that the issue isn't the result something not being right.

I asked

Have you tried recording a macro as I suggested?

your reply would appear to be

Macro has .themeColor = xlThemeColorAccent6 for green

which doesn't really tell me anything.

 

[Valentine]

sorry I thought I had put the whole code in here, but here is an update (have to do multiple posts it exceeds 10000 characters:

Private Sub cmdT2T_Click()

    Dim xlApp As Object
    Dim xlWB As Object
    Dim wsNew As Object
    Dim rsRoster As DAO.Recordset
    Dim rsLeave As DAO.Recordset
    Dim dbCurr As DAO.Database
    Dim strRoster As String
    Dim strLeave As String
    Dim rng As Object
    Dim x As Long
    Dim rownum As Integer
    Dim i As Integer
    Dim filepath As String
    Dim filename As String
    Dim initDate As Date
    
    'Set variables
    filepath = "\\corp\coi$\USCC\USAE\Troop 2 Task\"
    Set xlApp = CreateObject("Excel.Application")
    Set xlWB = xlApp.Workbooks.Add
    xlApp.Visible = True
    ' Set Recordsets
    Set dbCurr = CurrentDb()
    strRoster = "SELECT Roster.[DoD ID], Roster.[Last Name], Roster.[First Name] " _
              & "FROM Roster " _
              & "WHERE (((Roster.[Last Name]) Not Like 'AAA*') AND ((Roster.Status) Not Like 'Archive')) " _
              & "ORDER BY Roster.[Last Name];"
    Set rsRoster = dbCurr.OpenRecordset(strRoster)
    strLeave = "SELECT Roster.[DoD ID], Leave.[Start Date], Leave.[End Date], Roster.Status " _
             & "FROM Roster INNER JOIN Leave ON Roster.[DoD ID] = Leave.[DoD ID] " _
             & "WHERE (((Leave.[Start Date]) Between DateSerial(Year(Date()),1,1) And DateSerial(Year(Date()),12,31)) AND ((Roster.Status) Not Like 'Archive')) OR (((Leave.[End Date]) Between DateSerial(Year(Date()),1,1) And DateSerial(Year(Date()),12,31)));"
    Set rsLeave = dbCurr.OpenRecordset(strLeave)
    ' create excel document with each month as its own sheet
    For x = 1 To 12
        rsRoster.MoveFirst
        Set wsNew = xlWB.worksheets.Add(after:=xlWB.worksheets(xlWB.worksheets.Count))
        ' baselines for the spreadsheet
        wsNew.Name = MonthName(x)
        wsNew.Range("D:AH").ColumnWidth = "10"
        wsNew.cells(3, 1).Value = "DoD ID"
        wsNew.cells(3, 2).Value = "Last Name"
        wsNew.cells(3, 3).Value = "First Name"
        wsNew.Columns("A").ColumnWidth = "10"
        wsNew.Columns("B").ColumnWidth = "15"
        wsNew.Columns("C").ColumnWidth = "15"
        wsNew.cells(2, 4).Value = "1"
        wsNew.cells(2, 4).HorizontalAlignment = xlVAlignCenter
        wsNew.cells(2, 5).Value = "2"
        wsNew.cells(2, 5).HorizontalAlignment = xlVAlignCenter
        With wsNew.Range("A1", "C2")
            .MergeCells = True
            .Interior.ColorIndex = 16
        End With
        With wsNew.Range("A3", "C3")
            .HorizontalAlignment = xlVAlignCenter
            .Font.Bold = True
            .Font.Size = 14
        End With
        'add in the roster
        wsNew.cells(4, 1).CopyFromRecordset rsRoster
        'freeze the ID and names
        wsNew.Columns("D").Select
        xlApp.ActiveWindow.FreezePanes = True

thats the top

 

[Valentine]

next piece:

Select Case wsNew.Name
            Case "January", "March", "May", "July", "August", "October", "December"
                wsNew.Range("D2:E2").Autofill Destination:=wsNew.Range("D2:AH2"), Type:=xlFillSeries
                With wsNew.Range("D1", "AH1")
                    .Font.Bold = True
                    .Font.Size = 12
                    .VerticalAlignment = xlVAlignCenter
                    .HorizontalAlignment = xlVAlignCenter
                    .MergeCells = True
                    If wsNew.Name = "January" Then
                        .Value = "January"
                        wsNew.cells(3, 4).Value = "Saturday"
                        wsNew.Range("D3").Autofill Destination:=wsNew.Range("D3:AH3"), Type:=xlFillWeekdays
                        With wsNew.Range("D3", "AH3")
                            .HorizontalAlignment = xlVAlignCenter
                        End With
                    ElseIf wsNew.Name = "March" Then
                        .Value = "March"
                        wsNew.cells(3, 4).Value = "Tuesday"
                        wsNew.Range("D3").Autofill Destination:=wsNew.Range("D3:AH3"), Type:=xlFillWeekdays
                        With wsNew.Range("D3", "AH3")
                            .HorizontalAlignment = xlVAlignCenter
                        End With
                    ElseIf wsNew.Name = "May" Then
                        .Value = "May"
                        wsNew.cells(3, 4).Value = "Sunday"
                        wsNew.Range("D3").Autofill Destination:=wsNew.Range("D3:AH3"), Type:=xlFillWeekdays
                        With wsNew.Range("D3", "AH3")
                            .HorizontalAlignment = xlVAlignCenter
                        End With
                    ElseIf wsNew.Name = "July" Then
                        .Value = "July"
                        wsNew.cells(3, 4).Value = "Friday"
                        wsNew.Range("D3").Autofill Destination:=wsNew.Range("D3:AH3"), Type:=xlFillWeekdays
                        With wsNew.Range("D3", "AH3")
                            .HorizontalAlignment = xlVAlignCenter
                        End With
                    ElseIf wsNew.Name = "August" Then
                        .Value = "August"
                        wsNew.cells(3, 4).Value = "Monday"
                        wsNew.Range("D3").Autofill Destination:=wsNew.Range("D3:AH3"), Type:=xlFillWeekdays
                        With wsNew.Range("D3", "AH3")
                            .HorizontalAlignment = xlVAlignCenter
                        End With
                    ElseIf wsNew.Name = "October" Then
                        .Value = "October"
                        wsNew.cells(3, 4).Value = "Saturday"
                        wsNew.Range("D3").Autofill Destination:=wsNew.Range("D3:AH3"), Type:=xlFillWeekdays
                        With wsNew.Range("D3", "AH3")
                            .HorizontalAlignment = xlVAlignCenter
                        End With
                    ElseIf wsNew.Name = "December" Then
                        .Value = "December"
                        wsNew.cells(3, 4).Value = "Thursday"
                        wsNew.Range("D3").Autofill Destination:=wsNew.Range("D3:AH3"), Type:=xlFillWeekdays
                        With wsNew.Range("D3", "AH3")
                            .HorizontalAlignment = xlVAlignCenter
                        End With
                    End If
                End With
            Case "April", "June", "September", "November"
                wsNew.Range("D2:E2").Autofill Destination:=wsNew.Range("D2:AG2"), Type:=xlFillSeries
                With wsNew.Range("D1", "AG1")
                    .Font.Bold = True
                    .Font.Size = 12
                    .VerticalAlignment = xlVAlignCenter
                    .HorizontalAlignment = xlVAlignCenter
                    .MergeCells = True
                    If wsNew.Name = "April" Then
                        .Value = "April"
                        wsNew.cells(3, 4).Value = "Friday"
                        wsNew.Range("D3").Autofill Destination:=wsNew.Range("D3:AG3"), Type:=xlFillWeekdays
                        With wsNew.Range("D3", "AH3")
                            .HorizontalAlignment = xlVAlignCenter
                        End With
                    ElseIf wsNew.Name = "June" Then
                        .Value = "June"
                        wsNew.cells(3, 4).Value = "Wednesday"
                        wsNew.Range("D3").Autofill Destination:=wsNew.Range("D3:AG3"), Type:=xlFillWeekdays
                        With wsNew.Range("D3", "AH3")
                            .HorizontalAlignment = xlVAlignCenter
                        End With
                    ElseIf wsNew.Name = "September" Then
                        .Value = "September"
                        wsNew.cells(3, 4).Value = "Thursday"
                        wsNew.Range("D3").Autofill Destination:=wsNew.Range("D3:AG3"), Type:=xlFillWeekdays
                        With wsNew.Range("D3", "AH3")
                            .HorizontalAlignment = xlVAlignCenter
                        End With
                    ElseIf wsNew.Name = "November" Then
                        .Value = "November"
                        wsNew.cells(3, 4).Value = "Tuesday"
                        wsNew.Range("D3").Autofill Destination:=wsNew.Range("D3:AG3"), Type:=xlFillWeekdays
                        With wsNew.Range("D3", "AH3")
                            .HorizontalAlignment = xlVAlignCenter
                        End With
                    End If
                End With
            Case "February"
                wsNew.Range("D2:E2").Autofill Destination:=wsNew.Range("D2:AE2"), Type:=xlFillSeries
                With wsNew.Range("D1", "AE1")
                    .Font.Bold = True
                    .Font.Size = 12
                    .VerticalAlignment = xlVAlignCenter
                    .HorizontalAlignment = xlVAlignCenter
                    .MergeCells = True
                    .Value = "February"
                    wsNew.cells(3, 4).Value = "Tuesday"
                    wsNew.Range("D3").Autofill Destination:=wsNew.Range("D3:AE3"), Type:=xlFillWeekdays
                    With wsNew.Range("D3", "AE3")
                        .HorizontalAlignment = xlVAlignCenter
                    End With
                End With
        End Select
        'shade in the weekends
        For Each rng In wsNew.Range("D3:AH3")
            With rng
                If rng.Value = "Saturday" Then
                    wsNew.Columns(.Column).Interior.ColorIndex = 16
                ElseIf rng.Value = "Sunday" Then
                    wsNew.Columns(.Column).Interior.ColorIndex = 16
                End If
            End With
        Next
    Next x
    rsRoster.Close

thats how I have the sheets with each month

 

[Valentine]

rownum = 1
    While Not rsLeave.EOF
        rownum = rownum + 1
        For i = 0 To DateDiff("d", rsLeave![Start Date], rsLeave![End Date])
            initDate = rsLeave![Start Date]
            xlWB(MonthName(initDate)).cells(rownum, Day(initDate + i)).BackColor = 4
            'wsNew(MonthName(rsLeave![Start Date])).cell(rownum, Day(rsLeave![Start Date] + i)).BackColor = 4
            'wsNew(Month(rsLeave![Start Date])).cells(rownum, Day(rsLeave![Start Date] + i)).BackColor = 4
            'wsNew(Month(rsLeave![Start Date])).cells(rownum, Day(rsLeave![Start Date] + i)).Interior.ColorIndex = 4
        Next i
        rsLeave.MoveNext
    Wend
    rsLeave.Close
    ' save file
    xlWB.SaveAs filename:=filepath & "T2T as of " + Format(Date, "YYYYMMDD") & ".xlsx"
    Set rsRoster = Nothing
    Set rsLeave = Nothing

End Sub

here is the bottom the part that has the issues. trying to get the days into the spreadsheet.

Here is what the macro said:

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("I8:M8").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("L10").Select
End Sub