ExcelBanter - Worksheet Data Sorting

"Paul" wrote in message
...
I would like to know if anyone has a program which will sort data on a
worksheet. Basically I have a task that involves viewing a huge worksheet
called (Raw Data)filled with heaps of cases and I have to cut and paste a
line where the beginning cell is "X' for example and then paste that line
to
'X's seperate sheet in the the workbook. I have about 50 different x's and
this task is sooo time consuming. Is there a program which will recognise
each line by the first cell cut the line and paste it to the specific
sheet,
and then so on for the next value???

Hello

Try the simple macro below. It is very simplistic as it is difficult to
write something specific for your app without knowing more about your app :)

Major assumptions as written (although very easy to change):
* Raw data is in a table starting in cell A1 in a sheet called "RawData"
* No blank rows in column 1 allowed within this table of data
* Each "item" will get copied to its own worksheet. Each row of new data
is inserted into the first row in these new worksheets, so the data will be
in reverse order to the original raw data order
* Entire row is copied over
* Data is removed from the raw data worksheet after it is copied over
* Sorting the raw data will help speed wise, but is not necessary
* May fail if formulas were present in the raw data

Hopefully this will help, or be a start for you at least.

Regards
A

Option Explicit
Sub Macro1()
'Assumptions: No blank rows in the raw data list
' Raw data starts in row1, col1 in a worksheet called "RawData"
' Entire line is cut and pasted
' Pasting data into top row of each new worksheet. This
reverses the order of the data
' More efficient if raw data is sorted, but not required
' Assumes raw data only, no formulas

Dim strCurrentValue As String
Dim rawWorksheet As Worksheet

strCurrentValue = "rubbishStartingValue"

Set rawWorksheet = Worksheets("RawData")
Range("A1").Activate
'Keep looping over the raw data list until a blank cell is encountered in
the first column
While (ActiveCell.Value < "")
If ActiveCell < strCurrentValue Then
'New item identified, make a new worksheet if it doesnt already
exist
'To check for the worksheet existing try to access it, an error will
be thrown if it doesnt exist and we can detect this error
On Error Resume Next
ActiveWorkbook.Worksheets(ActiveCell.Value).Activa te
If Err Then
'Worksheet didnt exist so Excel threw an error
Sheets.Add after:=Sheets(Worksheets.Count)
rawWorksheet.Activate
Sheets(Worksheets.Count).Name = ActiveCell.Value
End If
Err.Clear 'clear any errors
strCurrentValue = ActiveCell.Value
End If
'Cut and paste over the row of data
rawWorksheet.Activate
Rows(1).Select
Selection.Cut
Sheets(strCurrentValue).Activate
'Paste the cut row into the top row of the worksheet
Range("A1").Activate
Selection.Insert shift:=xlDown
rawWorksheet.Activate
Selection.Delete
Wend

End Sub