Array to check for new columns is only half-working

[Gingertrees]

I get a daily report, and since the columns included in this report change sometimes, I created a test for new columns. This code is SUPPOSED to move any new columns over to the right, and color each new column red. It only does the first half.

It successfully moves the new columns, but I can't get the coloring to work right. Say my new report comes with two new columns, "Iguana" and "Gecko", between Cat and Dog. It will move the new columns to the far right (as it should), but then colors columns Dog through Fish (everything after the first new column, but NOT the new additions themselves!).

Sub SimpleTest()
Dim arrinitialCols As Variant, ndx As Integer
Dim Found As Range, counter As Integer
'find new columns, move to the end, color new columns.
arrinitialCols = Array("Cat", "Dog", "Bird", "Turtle", _
                    "Fish")
counter = 1
Application.ScreenUpdating = False
For ndx = LBound(arrinitialCols) To UBound(arrinitialCols)
    Set Found = Rows("1:1").Find(arrinitialCols(ndx), LookIn:=xlValues, LookAt:=xlWhole, _
                      SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
    If Not Found Is Nothing Then
        If Found.Column <> counter Then
            Found.EntireColumn.Cut
            Columns(counter).Insert Shift:=xlToRight
            Columns(counter).EntireColumn.Interior.ColorIndex = 3
            '///I just want to color the new column(s), but cannot get it right!////
            Application.CutCopyMode = False
        End If
        counter = counter + 1
    End If
Next ndx
MsgBox ("Test is complete. Any red columns are new / have new titles.")
Application.ScreenUpdating = True
End Sub

 

[Fluff]

How about

Sub SimpleTest()
Dim arrinitialCols As Variant, ndx As Integer
Dim Found As Range, counter As Integer
'find new columns, move to the end, color new columns.
arrinitialCols = Array("Vol", "Code", "Date", "AB Packs", _
                    "Weight")
counter = 1
Application.ScreenUpdating = False
For ndx = LBound(arrinitialCols) To UBound(arrinitialCols)
    Set Found = Rows("1:1").Find(arrinitialCols(ndx), LookIn:=xlValues, LookAt:=xlWhole, _
                      SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
    If Not Found Is Nothing Then
        If Found.Column <> counter Then
            Found.EntireColumn.Cut
            Columns(counter).Insert Shift:=xlToRight
            Application.CutCopyMode = False
        End If
        counter = counter + 1
    End If
Next ndx
Range(Cells(1, UBound(arrinitialCols) + 2), Cells(1, 1).End(xlToRight)).EntireColumn.Interior.Color = vbRed
MsgBox ("Test is complete. Any red columns are new / have new titles.")
Application.ScreenUpdating = True
End Sub

 

[Gingertrees]

Thanks - that worked!

 

[Fluff]

Glad to help & thanks for the feedback