Inserting a column conditionally based on date using VBA - excel

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.,