Inserting a cell when it contain specific words and moving original cell to the right

[paulc9499]

Hi,

I need to insert a cell and move the original cell to the right but only if the cell contains a specific word.

I have managed to get it to find the cell in the range and highlight the text in bold (which i don't need to do) but are struggling to get it to insert a cell in its place and moving everything to the right.

Any help gratefully received

Many thanks
Paul

 

[Brad_Miller]

Any chance you can make this code select and insert 8 rows?

 

[wideboydixon]

Public Sub MoveAdminToRight()

Dim lastRow As Long
Dim thisRow As Long
Const SearchColumn = "A" ' Change this to be the column that needs to be moved
Const SearchText = "admin" ' Change this to be the text we're looking for
Const ColumnCount = 8 ' Change this to be the number of columns to insert

lastRow = Cells(Rows.Count, SearchColumn).End(xlUp).Row

For thisRow = 1 To lastRow
    If Cells(thisRow, SearchColumn).Value = SearchText Then
        Cells(thisRow, SearchColumn).Resize(1, ColumnCount).Insert xlShiftToRight
    End If
Next thisRow

End Sub

WBD

 

[Brad_Miller]

Legend Thanks!