On Feb 1, 10:22*am, DIDS wrote:
Hi Don,

* * * Thank you for your reply. *I have been working on this and
cobbing together code I found on some sites and it does what I want
except for one issue. *If a Cell in Column B is blank. *It is copying
the cell above it into the cell that should be blank. *So what I want
to do is if the cell in Column B is blanck leave it blank. *Any ideas
on how to accomplish this? *Any help would be appreciated.

This is what I have before running my code:

CELL B92 = AXIQWQTS
CELL B93 = Blank Cell
CELL B94 = AXIDDIDS

This is what I have after running my code:

CELL B92 = AXIQWQTS
CELL B93 = AXIQWQTS
CELL B94 = AXIDDIDS

Here is my code:

Dim LR As Long, i As Long, LC As Integer
Dim X As Variant
Dim r As Range, iCol As Integer
On Error Resume Next
Set r = Application.InputBox("Click in the column to split by",
Type:=8)
On Error GoTo 0
If r Is Nothing Then Exit Sub
iCol = r.Column
Application.ScreenUpdating = False
LC = Cells(1, Columns.Count).End(xlToLeft).Column
LR = Cells(Rows.Count, iCol).End(xlUp).Row
Columns(iCol).Insert
For i = LR To 1 Step -1
* * With Cells(i, iCol + 1)
* * * * If InStr(.Value, " ") = 0 Then
* * * * * * .Offset(, -1).Value = .Value
* * * * Else
* * * * * * X = Split(.Value, " ")
* * * * * * .Offset(1).Resize(UBound(X)).EntireRow.Insert
* * * * * * .Offset(, -1).Resize(UBound(X) - LBound(X) + 1).Value =
Application.Transpose(X)
* * * * End If
* * End With
Next i
Columns(iCol + 1).Delete
LR = Cells(Rows.Count, iCol).End(xlUp).Row
With Range(Cells(1, 1), Cells(LR, LC))
* * On Error Resume Next
* * .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
* * On Error GoTo 0
* * .Value = .Value
End With
* * * * With Columns("B")
* * * * * * .Replace What:="EOJ", Replacement:="#N/A", _
* * * * * * * * LookAt:=xlWhole, MatchCase:=False
* * * * * * .SpecialCells(xlConstants, xlErrors).EntireRow.Delete
* * * * End With
Application.ScreenUpdating = True
End Sub

What's wrong with what I gave you with ONE line added

Sub BreakEmUpSAS()
Dim c As Range
Dim i As Long
For Each c In Range("b19:b21")
'==added
If c = "" Then Cells(Rows.Count, "c").End(xlUp)(2) = "'"
'==
For i = 1 To Len(c) - 1 Step 9
Cells(Rows.Count, "c").End(xlUp)(2) = Mid(c, i, 9)
Next i
Next c
Columns("c").AutoFit
End Sub