Excel VBA Column Insertion Using Loop Function

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

Use `IsDate` before attempting `DateValue` on the cell's value. — BigBen, Jan 14 '20 at 18:07
Also be careful when inserting - does `i+1` still refer to the column you want it to? — BigBen, Jan 14 '20 at 18:11
[Avoiding the use of Select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) in your code may also be helpful — cybernetic.nomad, Jan 14 '20 at 18:24

Dang D. Khanh · Accepted Answer · 2020-01-14T19:05:37.260

0

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

edited Jan 14 '20 at 19:05

answered Jan 14 '20 at 18:57

Dang D. Khanh

1,440
6
13

Thank you for your help. Is there a way to make it insert to right if the date in B2 is the most recent date? – BevoMG Jan 14 '20 at 19:25

score 0 · Answer 2 · answered Jan 14 '20 at 21:15

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

Excel VBA Column Insertion Using Loop Function

2 Answers2