Macro to Shift Cells if Value not found

[MrMatt]

Hi

Hoping someone could help me with the following. I need a macro that will check all cells in Column A and if a colon is not present in the cell then shift the cell to the right.

Before:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Column A[/TD]
[TD]Column B[/TD]
[TD]Column C[/TD]
[/TR]
[TR]
[TD]123[/TD]
[TD]456[/TD]
[TD]789[/TD]
[/TR]
[TR]
[TD]12:40[/TD]
[TD]abc[/TD]
[TD]def[/TD]
[/TR]
[TR]
[TD]Text[/TD]
[TD]ghi[/TD]
[TD]jkl[/TD]
[/TR]
</tbody>[/TABLE]


After:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Column A[/TD]
[TD]Column B[/TD]
[TD]Column C[/TD]
[TD]Column D[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]123[/TD]
[TD]456[/TD]
[TD]789[/TD]
[/TR]
[TR]
[TD]12:40[/TD]
[TD]abc[/TD]
[TD]def[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Text[/TD]
[TD]ghi[/TD]
[TD]jkl[/TD]
[/TR]
</tbody>[/TABLE]




Thanks in advance.

Matt

 

[Comfy]

Here you go give this a shot:

Sub ShiftRight()
Dim LastRow     As Long
Dim LastCol     As Long
Dim i           As Long


LastRow = Range("A65536").End(xlUp).Row


For i = 1 To LastRow
    If InStr(1, Cells(i, 1).Text, ":") = 0 Then
    LastCol = Cells(i, Columns.Count).End(xlToLeft).Column
        Range(Cells(i, 1), Cells(i, LastCol)).Cut Destination:=Range(Cells(i, 2), Cells(i, LastCol + 1))
    End If
Next i




End Sub

 

[wrightyrx7]

Beat me to it Comfy haha..

Here's my attempt at in anyway :P

Sub test()
Dim Rng As Range, i As Range

With ActiveSheet
    Set Rng = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
    For Each i In Rng
        If InStr(1, i.Text, ":", 1) = 0 Then i.Insert Shift:=xlToRight
    Next i
End With
End Sub

 

[MrMatt]

Here you go give this a shot:

Sub ShiftRight()
Dim LastRow     As Long
Dim LastCol     As Long
Dim i           As Long


LastRow = Range("A65536").End(xlUp).Row


For i = 1 To LastRow
    If InStr(1, Cells(i, 1).Text, ":") = 0 Then
    LastCol = Cells(i, Columns.Count).End(xlToLeft).Column
        Range(Cells(i, 1), Cells(i, LastCol)).Cut Destination:=Range(Cells(i, 2), Cells(i, LastCol + 1))
    End If
Next i




End Sub

Thanks, this works

 

[MrMatt]

Beat me to it Comfy haha..

Here's my attempt at in anyway :P

Sub test()
Dim Rng As Range, i As Range

With ActiveSheet
    Set Rng = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
    For Each i In Rng
        If InStr(1, i.Text, ":", 1) = 0 Then i.Insert Shift:=xlToRight
    Next i
End With
End Sub

As does this

Thanks both for the prompt responses.

 

[wrightyrx7]

No problem, thank you for the feedback.