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

 

[GJSBED]

Is this any help in column A I have just put a b c d ( b being the word that triggers the shift right part of the code)

Range("A1").Select

'
Do Until ActiveCell = "End"


If ActiveCell <> "b" Then ActiveCell.Offset(1, 0).Select


    If ActiveCell = "b" Then Selection.EntireRow.Insert
    ActiveCell.Offset(1, 0).Select
     Range(Selection, Selection.End(xlDown)).Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    
    Loop
    
    End Sub

 

[wideboydixon]

Public Sub InsertBlankCell()

Dim lastRow As Long
Dim thisRow As Long

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

For thisRow = 1 To lastRow
    If Cells(thisRow, 1).Value = "b" Then
        Cells(thisRow, 1).Insert (xlShiftToRight)
    End If
Next thisRow

End Sub

WBD

 

[paulc9499]

Is this any help in column A I have just put a b c d ( b being the word that triggers the shift right part of the code)

Range("A1").Select

'
Do Until ActiveCell = "End"


If ActiveCell <> "b" Then ActiveCell.Offset(1, 0).Select


    If ActiveCell = "b" Then Selection.EntireRow.Insert
    ActiveCell.Offset(1, 0).Select
     Range(Selection, Selection.End(xlDown)).Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    
    Loop
    
    End Sub

Thanks for this but it doesn't quite work how i need it to.

I change the range to AU1:AU3500 and the b to admin but first the cell which is blank it inserts a cell and moves it to the right, then the second which is still blank inserts two cells and so it goes on.

What i need to do is go down the AU column (for example) find any cells with the word admin, then insert a blank cell and move the one containing admin to the right.

Thanks
Paul

 

[paulc9499]

Sorry it doesn't seem to work for me, I don't get any output.

Is there something I am missing?

Thanks
Paul

 

[paulc9499]

Public Sub InsertBlankCell()

Dim lastRow As Long
Dim thisRow As Long

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

For thisRow = 1 To lastRow
    If Cells(thisRow, 1).Value = "b" Then
        Cells(thisRow, 1).Insert (xlShiftToRight)
    End If
Next thisRow

End Sub

WBD

Sorry it doesn't seem to work for me, I don't get any output.

Is there something I am missing?

Thanks
Paul

 

[wideboydixon]

It would help if you posted a sample of your data. Which column contains the text to check and what is the exact text you're checking for?

WBD

 

[paulc9499]

It would help if you posted a sample of your data. Which column contains the text to check and what is the exact text you're checking for?

WBD

Not sure if this is what you meant as couldn't work out a away to put the actual spreadsheet on here. As you can see when admin is the wrong column it throws everything else. I would like to search that column and when finds admin (in this case) it inserts a cell and moves everything to the right so it all lines up.

Hope that makes sense
Paul

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]admin[/TD]
[TD]dog coat[/TD]
[TD]Large[/TD]
[TD]Red[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]admin[/TD]
[TD]dog coat[/TD]
[TD]Large[/TD]
[TD]Black[/TD]
[/TR]
[TR]
[TD]admin[/TD]
[TD]dog coat[/TD]
[TD]small[/TD]
[TD]Blue[/TD]
[TD]Winter[/TD]
[/TR]
[TR]
[TD]admin[/TD]
[TD]dog coat[/TD]
[TD]small[/TD]
[TD]Yellow[/TD]
[TD]Winter[/TD]
[/TR]
[TR]
[TD]admin[/TD]
[TD]dog coat[/TD]
[TD]medium[/TD]
[TD]Green[/TD]
[TD]Summer[/TD]
[/TR]
</tbody>[/TABLE]

 

[wideboydixon]

OK. I'm going to assume that it's column A that needs to move across but you can change that in the code if necessary:

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

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

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

End Sub

WBD

 

[paulc9499]

OK. I'm going to assume that it's column A that needs to move across but you can change that in the code if necessary:

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

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

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

End Sub

WBD

That is awesome and does exactly what i need it to do.

Thank you so much, I am sure I will back for more assistance.

Many thanks
Paul