Excel VBA Column Insertion Using Loop Function - excel

Question

I've got dates in Row 2 and have the following code to insert a column based on whether the date in B1 is less than the date in B2, C2, etc....
Sub Test3()
If DateValue(Cells(1, 2).Value) < DateValue(Cells(2, 2).Value) Then
Range("B2").EntireColumn.Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(2, Selection.Column).Select
ActiveCell.Value = Range("B1")
ElseIf DateValue(Cells(1, 2).Value) < DateValue(Cells(2, 3).Value) Then
Range("C2").EntireColumn.Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(2, Selection.Column).Select
ActiveCell.Value = Range("B1")
End If
End Sub
The above code works and adds a column at the right place and puts a date in row 2 of the column.
Obviously it would be much easier for me to loop this but I am having trouble getting the loop to work. Here is what I have so far:
Sub DateLoopTest()
Dim i As Integer
i = 1
Do Until DateValue(Cells(1, 2).Value) < DateValue(Cells(2, i + 1).Value)
Cells(2, i + 1).EntireColumn.Select
i = i + 1
Loop
ActiveCell.EntireColumn.Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(2, Selection.Column).Select
ActiveCell.Value = Range("B1")
End Sub
I am getting Run-Time error '13': Type mismatch
No matter how much I mess with it I can't get it to loop like I want in my 1st example. Any suggestions

Answer 1

you can refer to this code:
Sub DateLoopTest()
Dim i As Integer
i = 0
'Loop from [B2] offset 0 to 1,2... -> then stop at [b2].offset(0,i)
Do Until (DateValue([b1]) < DateValue(IIf(IsDate([b2].Offset(0, i)), [b2].Offset(0, i), [b1])))
i = i + 1
Loop
[b2].Offset(0, i).EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
[b2].Offset(0, i).Value = [b1]
End Sub

Answer 2

maybe i got it wrong because i'm just looking at your code, try this again, hope it helps :)
Sub DateLoopTest1()
Dim i As Integer, isCellhere As Boolean, isExistCell As Boolean, isRecentday As Boolean: i = 0:
isRecentday = True
'get lastCell index for Loop
Dim iLast As Integer: iLast = Cells(2, 15000).End(xlToLeft).Column
Dim iMax As Integer: iMax = 2 'default
Dim Cellmax As Range: Set Cellmax = [b2] 'default
Dim Datedefault As Variant: Datedefault = #1/1/1000#
If iLast = 1 Then Exit Sub
'Loop until CellMax
For i = 0 To iLast - 2
isCellhere = Datedefault < DateValue(IIf(IsDate([b2].Offset(0, i)), [b2].Offset(0, i), Datedefault))
'stop if True
If isCellhere Then Set Cellmax = [b2].Offset(0, i): Datedefault = DateValue([b2].Offset(0, i).Value)
Next i
Cellmax.EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Cellmax.Offset(0, -1).Value = [b1]
End Sub