Is there a better way? (1 Viewer)

CJ_London

Super Moderator
Staff member
Local time
Today, 05:14
Joined
Feb 19, 2013
Messages
14,401
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

Lifelong Learner
Local time
Yesterday, 21:14
Joined
Mar 14, 2017
Messages
6,541
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

Enthusiastic Amateur
Local time
Today, 05:14
Joined
Sep 21, 2011
Messages
10,561
Would be the column number that matches the date for that day, surely?
 

Valentine

Member
Local time
Today, 00:14
Joined
Oct 1, 2021
Messages
216
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

Super Moderator
Staff member
Local time
Today, 05:14
Joined
Feb 19, 2013
Messages
14,401
not sure this would be the exact syntax but something like

Code:
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

Member
Local time
Today, 00:14
Joined
Oct 1, 2021
Messages
216
not sure this would be the exact syntax but something like

Code:
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

Super Moderator
Staff member
Local time
Today, 05:14
Joined
Feb 19, 2013
Messages
14,401
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

Member
Local time
Today, 00:14
Joined
Oct 1, 2021
Messages
216
I am getting "Object doesn't support this property or method"

Code:
    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

Super Moderator
Staff member
Local time
Today, 05:14
Joined
Feb 19, 2013
Messages
14,401
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

Member
Local time
Today, 00:14
Joined
Oct 1, 2021
Messages
216
Made that change, still same error.

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

thats the line that is highlighted.
 

CJ_London

Super Moderator
Staff member
Local time
Today, 05:14
Joined
Feb 19, 2013
Messages
14,401
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

Member
Local time
Today, 00:14
Joined
Oct 1, 2021
Messages
216
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

Super Moderator
Staff member
Local time
Today, 05:14
Joined
Feb 19, 2013
Messages
14,401
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

Lifelong Learner
Local time
Yesterday, 21:14
Joined
Mar 14, 2017
Messages
6,541
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

Member
Local time
Today, 00:14
Joined
Oct 1, 2021
Messages
216
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.

Code:
    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.
Code:
 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

Super Moderator
Staff member
Local time
Today, 05:14
Joined
Feb 19, 2013
Messages
14,401
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

Member
Local time
Today, 00:14
Joined
Oct 1, 2021
Messages
216
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:
Code:
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

Member
Local time
Today, 00:14
Joined
Oct 1, 2021
Messages
216
next piece:

Code:
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

Member
Local time
Today, 00:14
Joined
Oct 1, 2021
Messages
216
Code:
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:
Code:
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
 

Users who are viewing this thread

Top Bottom