Recorded Macro Needs Altering

[YellowLabPro]

Hello All,
I have recorded a macro that selects the cells in Column B that contain data. However as my data changes and either grows or shrinks, I would like to alter the code to accommodate it dynamically, rather than having to edit the code each time manually. As I am brand new to VBA and my second post here to the board, I am extremely green w/ VBA.

The purpose of this code is to split the text in Column B w/ the Excel Feature "Text to Columns". My data now resides in B1:B9722.

Exisiting Macro:
[vba]Selection.AutoFill Destination:=Range("B1:B5247")
Range("B1:B5247").Select
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C5247")
Range("C1:C5247").Select
Columns("B:B").Select
Selection.Copy
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Copy
Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("D").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("A:C").Select
Selection.Delete shift:=xlToLeft
Columns("A:A").Select
Range("A1:B5247").Sort Key1:=Range("A1"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("A:A").EntireColumn.AutoFit
Selection.ColumnWidth = 10.71
Columns("B:B").EntireColumn.AutoFit
End Sub[/vba]

Thanks

YLP

[Bob Phillips]

Try this

[vba]

Dim iLastRow As Long

iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
Range("B1:C1").AutoFill Destination:=Range("B1:C1").Resize(iLastRow)
Columns("B:B").Copy
Range("D1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Columns("C:C").Copy
Range("E1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
With Columns("C")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
End With
Columns("A:C").Delete shift:=xlToLeft
Range("A1:B5247").Sort Key1:=Range("A1"), _
Order1:=xlDescending, _
Header:=xlGuess
Columns("A:B").EntireColumn.AutoFit
[/vba]

[YellowLabPro]

XLD,
Thanks for helping. In subing your code, I only could get partial results. I am including the worksheet, a sample, for illustration. There are three tabs in this w-book, Text To Columns is the results I would like from the macro, SplitText is my original macro and XLD VBA is yours.
You will see that SplitText is eliminating everything and copying down the an errorneous record number increasing it by 1. XLD VBA is doing a little better but not what I need. I suspect your code is not providing code because it was based off original bad code.

Could you assist on this please?

Thanks,

YLP