Inserting a column conditionally based on date using VBA

Question

I'm trying to find a way to automatically insert a column based on a date. Here's some context:

• The top row of my spreadsheet (Row 1) contains dates in the format yyyy/mm/dd
• The dates aren't day-by-day; they are weekly (i.e. one cell may say 2015/09/21 the next will say 2015/09/28 and the next will say 2015/10/05) so this can change from year to year
• I need to find a way to automatically insert ONE column at the end of each quarter and TWO columns at the end of each half (i.e. ONE column between March and April, TWO between June and July, ONE between September and October, and TWO between December and January)

So far, this is what I am using to traverse the top row and see if the date is before October but after September. The dates start from cell I1. Although the code executes without any error, it does not actually do anything. Any help you all can offer will be appreciated.

With Sheets("Sheet1")
    Range("I1").Select
    Do Until IsEmpty(ActiveCell)

        If ActiveCell.Value < DateValue("2015/10/1") And ActiveCell.Offset(0, 1).Value > DateValue("2015/9/28") Then
            Range(ActiveCell).EntireColumn.Insert
        End If

        ActiveCell.Offset(0, 1).Select
    Loop
End With

Answer 1

I think you're off to a good start with your method. You should be able to just check if the day of the month is less than or equal to 7. That should indicate the first week in a month. If that month is 4 or 10, insert a column. If it's 1 or 7, insert two.

Dim r As Range
Set r = Range("I1")

Do Until IsEmpty(r)

    If Day(r) <= 7 Then
        Select Case Month(r)
            Case 4, 10
                r.EntireColumn.Insert
            Case 1, 7
                r.Resize(1, 2).EntireColumn.Insert
        End Select
    End If

    Set r = r.Offset(0, 1)

Loop

Answer 2

Going strictly on a change in months bewteen two cell in the header row may be the easiest logic.

Sub insert_quarter_halves()
    Dim c As Long

    With Worksheets("Sheet8")   'set this worksheet reference properly!
        For c = .Cells(1, Columns.Count).End(xlToLeft).Column To 2 Step -1
            If (Month(.Cells(1, c - 1).Value2) = 3 And Month(.Cells(1, c).Value2) = 4) Or _
               (Month(.Cells(1, c - 1).Value2) = 9 And Month(.Cells(1, c).Value2) = 10) Then
                .Cells(1, c).EntireColumn.Insert
            ElseIf (Month(.Cells(1, c - 1).Value2) = 6 And Month(.Cells(1, c).Value2) = 7) Or _
               (Month(.Cells(1, c - 1).Value2) = 12 And Month(.Cells(1, c).Value2) = 1) Then
                .Cells(1, c).Resize(1, 2).EntireColumn.Insert
            End If
        Next c
    End With

End Sub

When inserting columns, always travel from right to left or you risk skipping an entry that was pushed forward.,