How to cycle through dates incrementally by month in VBA

[Claire_Brummell]

Hi,

I'm trying to use VBA to create a 'calendar' style report.

Basically when you run the code to create the calendar it asks the user to enter a start and end date which it will then collate the information for. The information rather than being stored to a specific date, is linked to a month and year - so the date an item could be linked to would be Oct-2006 or Feb-2007 (though these are stored as full dates in the sheet - appearing as 01/12/2006 or 01/02/2007).

When I create the new sheet (which will house the calendar) I want it to create the calendar headings in the 3rd row starting at the second column, for the range of dates that the user has input.

So for example if the start date was 01/01/06 and the end date was 01/10/07, I want cell B3 to be "Jan-2006", C3 to be "Feb-2006", D3 to be "Mar-2006" right the way through to "Oct-2007". I'd like the values to be 01/01/06, 01/02/06 up to 01/10/07 and then change the format of the row to be "mmm-yyyy" so that I can use them for calculations if necessary.

Can anyone help?

 

[Claire_Brummell]

I've just re-read this and realised how complicated it sounds when actually it's very simple!!

- User enters start date and end date.
- I need VBA code which will then create a row in a given spreadsheet where each column will have the 1st of the month for every month between the start and end dates provided.
- So if start date was 01/01/06 and end date was 01/10/07 the first value in my row would be 01/01/06, the second 01/02/06, the third would be 01/03/06 right the way through to 01/10/07.
- I then need to format my row in "ddd-mmmm" format.

Hope this simplifies things.

 

[MarkAndrews]

Claire - Have you any experience of using MS Query & Parameters?

This would be an easy way

 

[Claire_Brummell]

Um...no, but it's not as simple as just pulling out this information - once I've created this table I then need to populate it with information collated from various sheets, depending on the values and then format it depending on other values - I'm getting there with the second part of it - I'm just trying to do one bit at a time.

Does MS query work a bit like Access?

 

[MarkAndrews]

MS Query allows you to select all the data from a user specified sheet, then filter certain elements using parameters which you choose

I have a document, which contains 15+ charts, a few data pages & 3 query pages (hidden) I then filter using Excel formula's to calibrate my data

The parameters are two cells (dates) which are changed by the user

Is this something similar as to what you are after?

 

[DominicB]

Good afternoon Claire_Brummell

Where does your start date go? End date? The code below expects to find your start date in A1 and your end date in A2. It looks a bit complicated, but Excel isn't great at handling dates. Perhaps it could be streamlined a bit - I haven't got time to go into it in depth at the moment, but it seems to work OK.

Sub test()
a = Month(Range("A1"))
b = 2
c = Year(Range("A1"))
d = Month(Range("A2"))
mth = Month((Range("A2")) - Month(Range("A1")))
yr = Year(Range("A2")) - Year(Range("A1"))
For n = 0 To (12 - Month(Range("A1") + 1) + ((yr - 1) * 12) + d)
Cells(3, b).Value = Format("01/" & a & "/" & c, "mmm-yyyy")
a = a + 1
b = b + 1
If a = 13 Then
c = c + 1
a = 1
End If
Next n
End Sub

HTH

DominicB

 

[Claire_Brummell]

Hmm...tough to visualise - I'll try and briefly summarise what I'm doing:

- I have several sheets all in the same format which have various columns of data.
- One field is highlight type, highlight title, one is highlight month and one is highlight level.
- I need to create a calendar which will
1) Create the calendar format for the dates that have been specified by the user (this is the bit that I wanted the help on above)
2) Cycle through all the sheets looking for entries whose highlight month falls in between the user specified dates
3) When an entry is found that falls in these dates a row is populated in the calendar. The highlight type is put in column 1, the highlight title is put in corresponding calendar month column for the entry's highlight month and this cell is then formatted based on the highlight level (there are three levels and the cell will be either green, yellow or red depending on the level).

I may not be able to get query anyway, but does this give you a picture of what I'm trying to do? Let me know if you need more info!

 

[Claire_Brummell]

Good afternoon Claire_Brummell

Where does your start date go? End date? The code below expects to find your start date in A1 and your end date in A2. It looks a bit complicated, but Excel isn't great at handling dates. Perhaps it could be streamlined a bit - I haven't got time to go into it in depth at the moment, but it seems to work OK.

Sub test()
a = Month(Range("A1"))
b = 2
c = Year(Range("A1"))
d = Month(Range("A2"))
mth = Month((Range("A2")) - Month(Range("A1")))
yr = Year(Range("A2")) - Year(Range("A1"))
For n = 0 To (12 - Month(Range("A1") + 1) + ((yr - 1) * 12) + d)
Cells(3, b).Value = Format("01/" & a & "/" & c, "mmm-yyyy")
a = a + 1
b = b + 1
If a = 13 Then
c = c + 1
a = 1
End If
Next n
End Sub

Sorry - I should have said I have twp input boxes which receive the values into variables which are declared at the start of the sub.

 

[DominicB]

Hi Claire_Brummell

Sorry - I should have said I have twp input boxes which receive the values into variables which are declared at the start of the sub.

So can you post the code you've got so far.

DominicB

 

[Claire_Brummell]

It's very messy and there's probably much better ways of doing it but this is where I'm at - I've put a load of asterisks where I need the help with the dates columns - I initially was going to just have jan-dec, but then realised this didn't help me as I needed the years as well.

The rest of the code is just trying to get it in the right direction for the next steps - I'm not quite there yet and I'm coding as I'm posting!

Sub Create_Highlight_Calendar()

Dim SummarySheet As String
Dim Worksheet_Counter As Integer
Dim Sheet_Row_Counter As Long
Dim Summary_Row_Counter As Long
Dim Summary_Column_Counter As Integer
Dim Worksheet_Name
Dim Calendar_Start_Date As Date
Dim Calendar_End_Date As Date
Dim CycleMonths As Integer
Dim CycleYears As Integer

' Delete Current Highlights calendar
Application.DisplayAlerts = False
'Sheets("Highlights Calendar").Delete
Application.DisplayAlerts = True
'Add new sheet

Sheets.Add before:=Sheets(1)
'Sheets(1).Name = "Monthly Report - " & Format(Date, "mmmm")

' Get start and end dates for calendar

Calendar_Start_Date = Application.InputBox(prompt:="Enter start date for calendar", Title:="Calendar")
Calendar_End_Date = Application.InputBox(prompt:="Enter end date for calendar", Title:="Calendar")

' Change new sheet name

Sheets(1).Name = "Highlights Calendar"

' Set Summary sheet to be active sheet

SummarySheet = ActiveSheet.Name

' Set Header

Sheets(SummarySheet).Cells(1, 1).Value = "Highlights calendar from " & Calendar_Start_Date & " to " & Calendar_End_Date
With Sheets(SummarySheet).Cells(1, 1)
        .Interior.ColorIndex = 34
        .Borders.LineStyle = xlContinuous
        .Borders.ColorIndex = 0
        .Font.Bold = "True"
        .Font.Size = 14
End With
With Sheets(SummarySheet).Range("A1:I1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With

' Set months within the range of the dates of the calendar
' ***************This is where I'm trying to get the code to create all the date columns for the range of dates that have been input

With Sheets(SummarySheet)
    .Cells(3, 2).Value = "January"
    .Cells(3, 3).Value = "February"
    .Cells(3, 4).Value = "March"
    .Cells(3, 5).Value = "April"
    .Cells(3, 6).Value = "May"
    .Cells(3, 7).Value = "June"
    .Cells(3, 8).Value = "July"
    .Cells(3, 9).Value = "August"
    .Cells(3, 10).Value = "September"
    .Cells(3, 11).Value = "October"
    .Cells(3, 12).Value = "November"
    .Cells(3, 13).Value = "December"
End With

With Sheets(SummarySheet).Range("B3:M3")
        .Interior.ColorIndex = 34
        .Borders.LineStyle = xlContinuous
        .Borders.ColorIndex = 0
        .Font.Bold = "True"
        .Font.Size = 14
End With


Summary_Row_Counter = 5



For Worksheet_Counter = 2 To ActiveWorkbook.Sheets.Count - 3

' Set Header for each worksheet

    Sheets(SummarySheet).Cells(Summary_Row_Counter, 1).Value = Sheets(Worksheet_Counter).Name
    With Sheets(SummarySheet).Cells(Summary_Row_Counter, 1)
        .Interior.ColorIndex = 35
        .Borders.LineStyle = xlContinuous
        .Borders.ColorIndex = 0
        .Font.Bold = "True"
        .Font.Size = 12
    End With
    Summary_Row_Counter = Summary_Row_Counter + 2
 
' Sort Current working worksheet

With Sheets(Worksheet_Counter)
    Columns("A:K").Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 End With
 
'Loop all active rows in the worksheet
    
    For Sheet_Row_Counter = 2 To Sheets(Worksheet_Counter).Rows.Count
    
    'Check the row has as value
    If Sheets(Worksheet_Counter).Cells(Sheet_Row_Counter, 1) <> "" Then

        ' Check the highlight month falls in the dates given
        If Sheets(Worksheet_Counter).Cells(Sheet_Row_Counter, 3) >= Calendar_Start_Date Then
            If Sheets(Worksheet_Counter).Cells(Sheet_Row_Counter, 3) < Calendar_End_Date Then
                    
                    'Enter the channel name
                    Sheets(SummarySheet).Cells(Summary_Row_Counter, 1).Value = Sheets(Worksheet_Counter).Cells(Sheet_Row_Counter, 1).Value
                    
                    'Look for the right date column
                    For Summary_Column_Counter = 1 To Sheets(SummarySheet).Columns.Count
                       If Sheets(SummarySheet).Cells(3, Summary_Column_Counter).Value = Sheets(Worksheet_Counter).Cells(Sheet_Row_Counter, 3).Value Then
                            'Enter the Highlight Title
                            Sheets(SummarySheet).Cells(Summary_Row_Counter, Summary_Column_Counter).Value = Sheets(Worksheet_Counter).Cells(Sheet_Row_Counter, 4).Value
                        End If

                    
'*********************This is where I'm up to so far*********************

[EDIT] If anyone can help me make this more streamlined and less resource hungry I'm open to any help on offer - I'm not an experience coder and therefore I'm not always aware of the simplest or best ways or doing things...