I have two worksheets I'm working on.
The first has a long list of items characterized in by one of four
identifiers (Adam, Bob, Charlie, David). So it would be something like this:

Adam Task 1 Due date X
Bob Task 34 Due date Y
Adam Task 2 Due date Z
Charlie Task 34 Due date Y
David Task 34 Due date Y
....

I want to make it so all of the rows for Adam (an none of the other rows)
are copied and pasted on to a separate worksheet. Then I will do the same for
Bob, Charlie, and David.

To make it even more complex, I do not want to past the entire contents of
each row, just certain columns. Here, let's say columns 1 and 2. So, the
resulting page for Adam would look like:
Adam Task 1
Adam Task 2

I've been wrestling with this for hours and can't get anywhere. Help! Thank
you very much!

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long
Dim sh As String

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, "A").Value < sh Then

sh = .Cells(i, "A").Value
On Error Resume Next
If Not Worksheets(sh).Name = sh Then Worksheets.Add.Name =
sh
On Error GoTo 0
If Worksheets(sh).Range("A1").Value = "" Then

NextRow = 1
Else

NextRow = Worksheets(sh).Range("A" &
..Rows.Count).End(xlUp).Row + 1
End If

.Cells(i, "A").Resize(, 2).Copy
Worksheets(sh).Cells(NextRow, "A")
End If
Next i
End With
End Sub

--
__________________________________
HTH

Bob

"elf27" wrote in message
...
I have two worksheets I'm working on.
The first has a long list of items characterized in by one of four
identifiers (Adam, Bob, Charlie, David). So it would be something like
this:

Adam Task 1 Due date X
Bob Task 34 Due date Y
Adam Task 2 Due date Z
Charlie Task 34 Due date Y
David Task 34 Due date Y
...

I want to make it so all of the rows for Adam (an none of the other rows)
are copied and pasted on to a separate worksheet. Then I will do the same
for
Bob, Charlie, and David.

To make it even more complex, I do not want to past the entire contents of
each row, just certain columns. Here, let's say columns 1 and 2. So, the
resulting page for Adam would look like:
Adam Task 1
Adam Task 2

I've been wrestling with this for hours and can't get anywhere. Help!
Thank
you very much!

Bob,
Thanks for your reply.
I'm getting a compiling error though because of an Else without an If. In
this portion of the code:

If Worksheets(sh).Range("A1").Value = "" Then NextRow = 1
Else NextRow = Worksheets(sh).Range("A" &
..Rows.Count).End(xlUp).Row + 1


I realize there's an if there, but Excel doesn't.


Thanks again.

You seem to have rolled individual lines in my code into 1. The NG also
wrapped lines, see if this is any better

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long
Dim sh As String

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, "A").Value < sh Then

sh = .Cells(i, "A").Value
On Error Resume Next
If Not Worksheets(sh).Name = sh Then _
Worksheets.Add.Name = sh
On Error GoTo 0
If Worksheets(sh).Range("A1").Value = "" Then

NextRow = 1
Else

NextRow = Worksheets(sh).Range("A" & _
.Rows.Count).End(xlUp).Row + 1
End If

.Cells(i, "A").Resize(, 2).Copy _
Worksheets(sh).Cells(NextRow, "A")
End If
Next i
End With
End Sub


--
__________________________________
HTH

Bob

"elf27" wrote in message
...
Bob,
Thanks for your reply.
I'm getting a compiling error though because of an Else without an If. In
this portion of the code:

If Worksheets(sh).Range("A1").Value = "" Then NextRow = 1
Else NextRow = Worksheets(sh).Range("A" &
.Rows.Count).End(xlUp).Row + 1


I realize there's an if there, but Excel doesn't.


Thanks again.

Still not working.
Getting an "error 9. Subscript out of range" on the line:
If Worksheets(sh).Range("A1").Value = "" Then

For some reason, it's creating a new sheet but not naming it (it remains
'Sheet 1') while sh has the file name as the value. That's why when it tries
to go to the worksheet called sh it's out of range.



"Bob Phillips" wrote:

You seem to have rolled individual lines in my code into 1. The NG also
wrapped lines, see if this is any better

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long
Dim sh As String

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, "A").Value < sh Then

sh = .Cells(i, "A").Value
On Error Resume Next
If Not Worksheets(sh).Name = sh Then _
Worksheets.Add.Name = sh
On Error GoTo 0
If Worksheets(sh).Range("A1").Value = "" Then

NextRow = 1
Else

NextRow = Worksheets(sh).Range("A" & _
.Rows.Count).End(xlUp).Row + 1
End If

.Cells(i, "A").Resize(, 2).Copy _
Worksheets(sh).Cells(NextRow, "A")
End If
Next i
End With
End Sub


--
__________________________________
HTH

Bob

"elf27" wrote in message
...
Bob,
Thanks for your reply.
I'm getting a compiling error though because of an Else without an If. In
this portion of the code:

If Worksheets(sh).Range("A1").Value = "" Then NextRow = 1
Else NextRow = Worksheets(sh).Range("A" &
.Rows.Count).End(xlUp).Row + 1


I realize there's an if there, but Excel doesn't.


Thanks again.

Do you have empty cells in column A?

How about strings that contain invalid characters in those cells (maybe dates
using the slash character)?

Add a line to help debug the program:

If .Cells(i, "A").Value < sh Then
msgbox i & vblf & .cells(i,"A").value
sh = .Cells(i, "A").Value

I bet Bob's routine would work fine with the test data you shared. But the fix
may depend on what's in those cells that's causing the error.

elf27 wrote:

Still not working.
Getting an "error 9. Subscript out of range" on the line:
If Worksheets(sh).Range("A1").Value = "" Then

For some reason, it's creating a new sheet but not naming it (it remains
'Sheet 1') while sh has the file name as the value. That's why when it tries
to go to the worksheet called sh it's out of range.

"Bob Phillips" wrote:

You seem to have rolled individual lines in my code into 1. The NG also
wrapped lines, see if this is any better

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long
Dim sh As String

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, "A").Value < sh Then

sh = .Cells(i, "A").Value
On Error Resume Next
If Not Worksheets(sh).Name = sh Then _
Worksheets.Add.Name = sh
On Error GoTo 0
If Worksheets(sh).Range("A1").Value = "" Then

NextRow = 1
Else

NextRow = Worksheets(sh).Range("A" & _
.Rows.Count).End(xlUp).Row + 1
End If

.Cells(i, "A").Resize(, 2).Copy _
Worksheets(sh).Cells(NextRow, "A")
End If
Next i
End With
End Sub


--
__________________________________
HTH

Bob

"elf27" wrote in message
...
Bob,
Thanks for your reply.
I'm getting a compiling error though because of an Else without an If. In
this portion of the code:

If Worksheets(sh).Range("A1").Value = "" Then NextRow = 1
Else NextRow = Worksheets(sh).Range("A" &
.Rows.Count).End(xlUp).Row + 1


I realize there's an if there, but Excel doesn't.


Thanks again.




--

Dave Peterson

Actually, previous post was wrong. I got it to work, but the problem is that
it created 130 sheets and then errored out.
Each sheet only had one line of information

"Bob Phillips" wrote:

You seem to have rolled individual lines in my code into 1. The NG also
wrapped lines, see if this is any better

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long
Dim sh As String

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, "A").Value < sh Then

sh = .Cells(i, "A").Value
On Error Resume Next
If Not Worksheets(sh).Name = sh Then _
Worksheets.Add.Name = sh
On Error GoTo 0
If Worksheets(sh).Range("A1").Value = "" Then

NextRow = 1
Else

NextRow = Worksheets(sh).Range("A" & _
.Rows.Count).End(xlUp).Row + 1
End If

.Cells(i, "A").Resize(, 2).Copy _
Worksheets(sh).Cells(NextRow, "A")
End If
Next i
End With
End Sub


--
__________________________________
HTH

Bob

"elf27" wrote in message
...
Bob,
Thanks for your reply.
I'm getting a compiling error though because of an Else without an If. In
this portion of the code:

If Worksheets(sh).Range("A1").Value = "" Then NextRow = 1
Else NextRow = Worksheets(sh).Range("A" &
.Rows.Count).End(xlUp).Row + 1


I realize there's an if there, but Excel doesn't.


Thanks again.

How about adding some line and change codes a little like below.

keiji

elf27 wrote:
Actually, previous post was wrong. I got it to work, but the problem is that
it created 130 sheets and then errored out.
Each sheet only had one line of information

"Bob Phillips" wrote:

You seem to have rolled individual lines in my code into 1. The NG also
wrapped lines, see if this is any better

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long
Dim sh As String

add the code below

Dim Acsh as Worksheet

set Acsh=ActiveSheet


Change the line below

With ActiveSheet

to

With Acsh


LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, "A").Value < sh Then

sh = .Cells(i, "A").Value
On Error Resume Next
If Not Worksheets(sh).Name = sh Then _
Worksheets.Add.Name = sh
On Error GoTo 0
If Worksheets(sh).Range("A1").Value = "" Then

NextRow = 1
Else

NextRow = Worksheets(sh).Range("A" & _
.Rows.Count).End(xlUp).Row + 1
End If

.Cells(i, "A").Resize(, 2).Copy _
Worksheets(sh).Cells(NextRow, "A")
End If
Next i
End With
End Sub


--
__________________________________
HTH

Bob

"elf27" wrote in message
...
Bob,
Thanks for your reply.
I'm getting a compiling error though because of an Else without an If. In
this portion of the code:

If Worksheets(sh).Range("A1").Value = "" Then NextRow = 1
Else NextRow = Worksheets(sh).Range("A" &
.Rows.Count).End(xlUp).Row + 1


I realize there's an if there, but Excel doesn't.


Thanks again.