CODEWITHSUNDEEP
excelvba
Fazila
Fazila

Reputation: 65

VBA: Insert 2 columns if header matches

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:

English FFT Target English Teacher Assessment English EFG Maths FFT Target Maths Teacher Assessment Maths EFG

What I need is

[blank column] [blank column] English FFT Target English Teacher Assessment English EFG [blank column] [blank column] Maths FFT Target Maths Teacher Assessment Maths EFG

The code I have is:

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

Unfortunately, this code inserts all the columns before English FFT Target rather than moving on and inserting columns before the next column containing FFT Target.

Any help would be greatly appreciated.

Thanks

Upvotes: 0

Views: 262

Answers (2)

SJR
SJR

Reputation: 23081

In case you want to stick with Find. As you are inserting columns, you need a bit of jiggery-pokery to check you are not recycling previously found values, and you need to set the search direction. Setting other parameters is also good practice.

However, I think Error 1004's approach makes more sense here.

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

Upvotes: 1

Error 1004
Error 1004

Reputation: 8230

i think this could helps you:

Option Explicit

Sub Insert()

    Dim LastColumn As Long, i As Long, Position As Long

    With ThisWorkbook.Worksheets("Sheet1")

        'Get the last column of Sheet 1, row 1
        LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column

        For i = LastColumn To 1 Step -1

            Position = InStr(1, .Cells(1, i), "FFT Target")

            If Position <> 0 Then

                .Range(.Cells(, i), .Cells(, i + 1)).EntireColumn.Insert

            End If

        Next i

    End With

End Sub

Upvotes: 2

Related Questions