Shift all cells over one column

[Annette]

How do I shift the cells over to next column if the data is not a date.

The cells contact numbers with a letter code at the end, and I need to shift
those over one cell to the right but any cells that have dates, leave those.
The dates are always on the first line and these numbers I'm referring to
appear under the dates:

example:

03/03/04
02398568H
03/03/04
238567387I

I want those numbers shifted into column B, but there are more numbers so
the entire row needs to be shifted. There is no more than 7 columns of
information per row.

Thanks!

 

[Tom Ogilvy]

Sub AAATester3()
Dim rng As Range, Cell As Range

Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
For Each Cell In rng
If Not IsDate(Cell) Then
Cell.Insert Shift:=xlShiftToRight
End If
Next

End Sub

Assumes a blank cell should be shifted as well and that dates are stored as
dates.

Test it on a copy of your data.

 

[Kevin Beckham]

Sub ShiftNonDateCells()
Dim dCell As Range
Dim rCount As Long

rCount = 0 'take advantage of a date first
Set dCell = Range("A1") 'put your start cell here
Do While Not IsEmpty(dCell.Offset(rCount, 0))
If Not IsDate(dCell.Offset(rCount, 0)) Then
dCell.Offset(rCount, 0).Insert xlToRight
End If
rCount = rCount + 1
Loop

End Sub

Kevin Beckham

 

[Stevie_mac]

Sub MoveNonDates()
Dim cSrc As Range, s As Worksheet
Set s = Sheets("Sheet1") ' Set Sheet name as required
Set cSrc = s.Cells(1, 1) 'Start at cell A1

While cSrc.Value <> ""
If IsDate(cSrc.Value) = False Then
cSrc.Insert xlShiftToRight
Set cSrc = cSrc.Offset(1, -1)
Else
Set cSrc = cSrc.Offset(1, 0)
End If
Debug.Print cSrc.Value
Wend
End Sub

 

[Annette]

Thanks ... this is working great also!

Sub MoveNonDates()
Dim cSrc As Range, s As Worksheet
Set s = Sheets("Sheet1") ' Set Sheet name as required
Set cSrc = s.Cells(1, 1) 'Start at cell A1

While cSrc.Value <> ""
If IsDate(cSrc.Value) = False Then
cSrc.Insert xlShiftToRight
Set cSrc = cSrc.Offset(1, -1)
Else
Set cSrc = cSrc.Offset(1, 0)
End If
Debug.Print cSrc.Value
Wend
End Sub