VBA: Insert 2 columns if header matches

[Fazila]

I need to insert 2 columns if the header contains "*FFT Target". I've found this code, however, it does not move on to the next column containing "FFT Target" but inserts the two rows before the first column where the heading matched.

Sheet headers I currently have are:

[TABLE="width: 500"]
<tbody>[TR]
[TD]English FFT Target[/TD]
[TD]English Teacher Assessment[/TD]
[TD]English EFG[/TD]
[TD]Maths FFT Target[/TD]
[TD]Maths Teacher Assessment[/TD]
[TD]Maths EFG[/TD]
[TD]Science FFT Target[/TD]
[TD]Science Teacher Assessment[/TD]
[TD]Science EFG[/TD]
[TD]Art FFT Target[/TD]
[TD]Art Teacher Assessment[/TD]
[TD]Art EFG[/TD]
[/TR]
</tbody>[/TABLE]

What I need is:

[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD]English FFT Target[/TD]
[TD]English Teacher Assessment[/TD]
[TD]English EFG[/TD]
[TD][/TD]
[TD][/TD]
[TD]Maths FFT Target[/TD]
[TD]Maths Teacher Assessment[/TD]
[TD]Maths EFG[/TD]
[TD][/TD]
[TD][/TD]
[TD]Science FFT Target[/TD]
[TD]Science Teacher Assessment[/TD]
[TD]Science EFG[/TD]
[TD][/TD]
[TD][/TD]
[TD]Art FFT Target[/TD]
[TD]Art Teacher Assessment[/TD]
[TD]Art EFG[/TD]
[/TR]
</tbody>[/TABLE]


The code I have is:

Sub inscols()

    Dim A As Range
    Dim lc As Long
    Dim i As Long
        
    Set A = Rows(1).Find(what:="*Target", LookIn:=xlValues, lookat:=xlPart)
    lc = Cells(1, Columns.Count).End(xlToLeft).Column
    
    For i = 2 To lc
          
            If A Is Nothing Then Exit Sub
            A.Resize(, 2).EntireColumn.Insert
    Next i
        
End Sub

I'm assuming instead of next i it should be next A or something?

Any help would be greatly appreciated.

Thanks

 

[Fazila]

if anyone is interested in a solution I got a response from another forum which worked great.

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">Sub x()

Dim A As Range
Dim lc As Long
Dim i As Long
Dim s As String

Set A = Rows(1).Find(What:="Target", after:=Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, _
SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)

If Not A Is Nothing Then
s = A.Address
Do
A.Resize(, 2).EntireColumn.Insert
s = Range(s).Offset(, 2).Address
Set A = Rows(1).FindNext(A)
Loop Until A.Address = s
End If

End Sub</code>