Code not working

[GregR]

Why does this code not work?

Sub CopyToCompleted()
Dim rFrom As Range
Dim rTo As Range
Dim C As Long 'Column #
Dim R As Long 'Row #

Set rTo = Sheets("Completed").Cells(Rows.Count, 1).End(xlUp)(1, 1)

On Error Resume Next
C = [B1].Column

Set rFrom = Sheets("Project Report").Range(Cells(3, C),
Cells(Rows.Count, C)).Find("N")
If Err.Number > 0 Then Exit Sub

For Each R In rFrom
rFrom.EntireRow.Copy rTo
rFrom.EntireRow.Delete

Next R
End Sub

What I am trying to accomplish is move all the rows where column "B" in
Sheets("Project Report") ="N" to the next empty row in
Sheets("Completed"). TIA

Greg

[Jim Thomlinson]

You are close but give this a try...

Public Sub CopyToComlete()
Dim wksCopyTo As Worksheet
Dim wksCopyFrom As Worksheet
Dim rngCopyTo As Range
Dim rngCopyFrom As Range
Dim rngToSearch As Range
Dim rngFirst As Range
Dim rngCurrent As Range

Set wksCopyTo = Sheets("Completed")
Set rngCopyTo = wksCopyTo.Range("A65536").End(xlUp).Offset(1, 0)

Set wksCopyFrom = Sheets("Project Report")
Set rngToSearch = wksCopyFrom.Columns(2)
Set rngCurrent = rngToSearch.Find("N")

If rngCurrent Is Nothing Then
MsgBox "N was not found"
Else
Set rngFirst = rngCurrent
Set rngCopyFrom = rngCurrent
Do
Set rngCopyFrom = Union(rngCopyFrom, rngCurrent)
Set rngCurrent = rngToSearch.FindNext(rngCurrent)
Loop Until rngFirst.Address = rngCurrent.Address
rngCopyFrom.EntireRow.Copy rngCopyTo
rngCopyFrom.EntireRow.Delete
End If

End Sub

--
HTH...

Jim Thomlinson


"GregR" wrote:

> Why does this code not work?
>
> Sub CopyToCompleted()
> Dim rFrom As Range
> Dim rTo As Range
> Dim C As Long 'Column #
> Dim R As Long 'Row #
>
> Set rTo = Sheets("Completed").Cells(Rows.Count, 1).End(xlUp)(1, 1)
>
> On Error Resume Next
> C = [B1].Column
>
> Set rFrom = Sheets("Project Report").Range(Cells(3, C),
> Cells(Rows.Count, C)).Find("N")
> If Err.Number > 0 Then Exit Sub
>
> For Each R In rFrom
> rFrom.EntireRow.Copy rTo
> rFrom.EntireRow.Delete
>
> Next R
> End Sub
>
> What I am trying to accomplish is move all the rows where column "B" in
> Sheets("Project Report") ="N" to the next empty row in
> Sheets("Completed"). TIA
>
> Greg
>
>

[GregR]

Jim, I need to exclude row 1 and 2 (header rows) from the "CopyFrom"
range. TIA

Greg

[William Benson]

Here's one way ... it looks like a kluge, but fewer lines of code, less
variables, I think it works ... maybe someone can clean it up if I am using
an object or two that is not necessary.

Bill Benson
http://www.xlcreations.com


Sub CopyToCompleted()
Dim rFrom As Range
On Error Resume Next
Do While Err.Number = 0
Set rFrom = Sheets("Project Report").Rows("2:65536").Columns(2).Find _
(what:="N", LookIn:=xlValues).EntireRow
If Err.Number <> 0 Then
GoTo AdvanceLoop
Else
With Sheets("Completed").UsedRange.SpecialCells(xlCellTypeLastCell)
rFrom.Copy
.Offset(-CInt(Sheets("Completed").UsedRange.SpecialCells(xlCellTypeLastCell).
_
EntireRow.Cells(2) <> ""), CInt(.EntireRow.Cells(2) <> "") _
* (.Column - 1)).Insert shift:=xlDown
rFrom.Delete shift:=xlUp
End With
End If
AdvanceLoop:
Loop
End Sub


"GregR" <[email protected]> wrote in message
news:[email protected]...
> Why does this code not work?
>
> Sub CopyToCompleted()
> Dim rFrom As Range
> Dim rTo As Range
> Dim C As Long 'Column #
> Dim R As Long 'Row #
>
> Set rTo = Sheets("Completed").Cells(Rows.Count, 1).End(xlUp)(1, 1)
>
> On Error Resume Next
> C = [B1].Column
>
> Set rFrom = Sheets("Project Report").Range(Cells(3, C),
> Cells(Rows.Count, C)).Find("N")
> If Err.Number > 0 Then Exit Sub
>
> For Each R In rFrom
> rFrom.EntireRow.Copy rTo
> rFrom.EntireRow.Delete
>
> Next R
> End Sub
>
> What I am trying to accomplish is move all the rows where column "B" in
> Sheets("Project Report") ="N" to the next empty row in
> Sheets("Completed"). TIA
>
> Greg
>

[Jim Thomlinson]

You just need to modify the range you are searching. Change...
Set rngToSearch = wksCopyFrom.Columns(2)
to
Set rngToSearch = range(wksCopyFrom.Range("B3", _
wksCopyfrom.Range("B65536").end(xlUp))

Or something like that (untested)
--
HTH...

Jim Thomlinson


"GregR" wrote:

> Jim, I need to exclude row 1 and 2 (header rows) from the "CopyFrom"
> range. TIA
>
> Greg
>
>

[Jim Thomlinson]

The code looks ok but you have to be careful using lastcell as it is not
necessarilly the first blank cell. Also it will run a bit slower because it
is copying and deleting everytime if finds a match instead of just once at
the end. (Not usually a big deal unless you have a whole pile of lines to
copy).
--
HTH...

Jim Thomlinson


"William Benson" wrote:

> Here's one way ... it looks like a kluge, but fewer lines of code, less
> variables, I think it works ... maybe someone can clean it up if I am using
> an object or two that is not necessary.
>
> Bill Benson
> http://www.xlcreations.com
>
>
> Sub CopyToCompleted()
> Dim rFrom As Range
> On Error Resume Next
> Do While Err.Number = 0
> Set rFrom = Sheets("Project Report").Rows("2:65536").Columns(2).Find _
> (what:="N", LookIn:=xlValues).EntireRow
> If Err.Number <> 0 Then
> GoTo AdvanceLoop
> Else
> With Sheets("Completed").UsedRange.SpecialCells(xlCellTypeLastCell)
> rFrom.Copy
> .Offset(-CInt(Sheets("Completed").UsedRange.SpecialCells(xlCellTypeLastCell).
> _
> EntireRow.Cells(2) <> ""), CInt(.EntireRow.Cells(2) <> "") _
> * (.Column - 1)).Insert shift:=xlDown
> rFrom.Delete shift:=xlUp
> End With
> End If
> AdvanceLoop:
> Loop
> End Sub
>
>
> "GregR" <[email protected]> wrote in message
> news:[email protected]...
> > Why does this code not work?
> >
> > Sub CopyToCompleted()
> > Dim rFrom As Range
> > Dim rTo As Range
> > Dim C As Long 'Column #
> > Dim R As Long 'Row #
> >
> > Set rTo = Sheets("Completed").Cells(Rows.Count, 1).End(xlUp)(1, 1)
> >
> > On Error Resume Next
> > C = [B1].Column
> >
> > Set rFrom = Sheets("Project Report").Range(Cells(3, C),
> > Cells(Rows.Count, C)).Find("N")
> > If Err.Number > 0 Then Exit Sub
> >
> > For Each R In rFrom
> > rFrom.EntireRow.Copy rTo
> > rFrom.EntireRow.Delete
> >
> > Next R
> > End Sub
> >
> > What I am trying to accomplish is move all the rows where column "B" in
> > Sheets("Project Report") ="N" to the next empty row in
> > Sheets("Completed"). TIA
> >
> > Greg
> >
>
>
>

[William Benson]

Good points. I know I should leave this stuff to the pros, but I can't
resist taking a crack at it now and again ;-)


"Jim Thomlinson" <[email protected]> wrote in message
news:[email protected]...
> The code looks ok but you have to be careful using lastcell as it is not
> necessarilly the first blank cell. Also it will run a bit slower because
> it
> is copying and deleting everytime if finds a match instead of just once at
> the end. (Not usually a big deal unless you have a whole pile of lines to
> copy).
> --
> HTH...
>
> Jim Thomlinson
>
>
> "William Benson" wrote:
>
>> Here's one way ... it looks like a kluge, but fewer lines of code, less
>> variables, I think it works ... maybe someone can clean it up if I am
>> using
>> an object or two that is not necessary.
>>
>> Bill Benson
>> http://www.xlcreations.com
>>
>>
>> Sub CopyToCompleted()
>> Dim rFrom As Range
>> On Error Resume Next
>> Do While Err.Number = 0
>> Set rFrom = Sheets("Project Report").Rows("2:65536").Columns(2).Find
>> _
>> (what:="N", LookIn:=xlValues).EntireRow
>> If Err.Number <> 0 Then
>> GoTo AdvanceLoop
>> Else
>> With
>> Sheets("Completed").UsedRange.SpecialCells(xlCellTypeLastCell)
>> rFrom.Copy
>>
>> .Offset(-CInt(Sheets("Completed").UsedRange.SpecialCells(xlCellTypeLastCell).
>> _
>> EntireRow.Cells(2) <> ""), CInt(.EntireRow.Cells(2) <>
>> "") _
>> * (.Column - 1)).Insert shift:=xlDown
>> rFrom.Delete shift:=xlUp
>> End With
>> End If
>> AdvanceLoop:
>> Loop
>> End Sub
>>
>>
>> "GregR" <[email protected]> wrote in message
>> news:[email protected]...
>> > Why does this code not work?
>> >
>> > Sub CopyToCompleted()
>> > Dim rFrom As Range
>> > Dim rTo As Range
>> > Dim C As Long 'Column #
>> > Dim R As Long 'Row #
>> >
>> > Set rTo = Sheets("Completed").Cells(Rows.Count, 1).End(xlUp)(1, 1)
>> >
>> > On Error Resume Next
>> > C = [B1].Column
>> >
>> > Set rFrom = Sheets("Project Report").Range(Cells(3, C),
>> > Cells(Rows.Count, C)).Find("N")
>> > If Err.Number > 0 Then Exit Sub
>> >
>> > For Each R In rFrom
>> > rFrom.EntireRow.Copy rTo
>> > rFrom.EntireRow.Delete
>> >
>> > Next R
>> > End Sub
>> >
>> > What I am trying to accomplish is move all the rows where column "B" in
>> > Sheets("Project Report") ="N" to the next empty row in
>> > Sheets("Completed"). TIA
>> >
>> > Greg
>> >
>>
>>
>>

[Jim Thomlinson]

Take enough cracks at it and you will be a pro.
--
HTH...

Jim Thomlinson


"William Benson" wrote:

> Good points. I know I should leave this stuff to the pros, but I can't
> resist taking a crack at it now and again ;-)
>
>
> "Jim Thomlinson" <[email protected]> wrote in message
> news:[email protected]...
> > The code looks ok but you have to be careful using lastcell as it is not
> > necessarilly the first blank cell. Also it will run a bit slower because
> > it
> > is copying and deleting everytime if finds a match instead of just once at
> > the end. (Not usually a big deal unless you have a whole pile of lines to
> > copy).
> > --
> > HTH...
> >
> > Jim Thomlinson
> >
> >
> > "William Benson" wrote:
> >
> >> Here's one way ... it looks like a kluge, but fewer lines of code, less
> >> variables, I think it works ... maybe someone can clean it up if I am
> >> using
> >> an object or two that is not necessary.
> >>
> >> Bill Benson
> >> http://www.xlcreations.com
> >>
> >>
> >> Sub CopyToCompleted()
> >> Dim rFrom As Range
> >> On Error Resume Next
> >> Do While Err.Number = 0
> >> Set rFrom = Sheets("Project Report").Rows("2:65536").Columns(2).Find
> >> _
> >> (what:="N", LookIn:=xlValues).EntireRow
> >> If Err.Number <> 0 Then
> >> GoTo AdvanceLoop
> >> Else
> >> With
> >> Sheets("Completed").UsedRange.SpecialCells(xlCellTypeLastCell)
> >> rFrom.Copy
> >>
> >> .Offset(-CInt(Sheets("Completed").UsedRange.SpecialCells(xlCellTypeLastCell).
> >> _
> >> EntireRow.Cells(2) <> ""), CInt(.EntireRow.Cells(2) <>
> >> "") _
> >> * (.Column - 1)).Insert shift:=xlDown
> >> rFrom.Delete shift:=xlUp
> >> End With
> >> End If
> >> AdvanceLoop:
> >> Loop
> >> End Sub
> >>
> >>
> >> "GregR" <[email protected]> wrote in message
> >> news:[email protected]...
> >> > Why does this code not work?
> >> >
> >> > Sub CopyToCompleted()
> >> > Dim rFrom As Range
> >> > Dim rTo As Range
> >> > Dim C As Long 'Column #
> >> > Dim R As Long 'Row #
> >> >
> >> > Set rTo = Sheets("Completed").Cells(Rows.Count, 1).End(xlUp)(1, 1)
> >> >
> >> > On Error Resume Next
> >> > C = [B1].Column
> >> >
> >> > Set rFrom = Sheets("Project Report").Range(Cells(3, C),
> >> > Cells(Rows.Count, C)).Find("N")
> >> > If Err.Number > 0 Then Exit Sub
> >> >
> >> > For Each R In rFrom
> >> > rFrom.EntireRow.Copy rTo
> >> > rFrom.EntireRow.Delete
> >> >
> >> > Next R
> >> > End Sub
> >> >
> >> > What I am trying to accomplish is move all the rows where column "B" in
> >> > Sheets("Project Report") ="N" to the next empty row in
> >> > Sheets("Completed"). TIA
> >> >
> >> > Greg
> >> >
> >>
> >>
> >>
>
>
>

[William Benson]

By the way the elegance of 'Set rngCopyFrom = Union(rngCopyFrom,
rngCurrent)' at first escaped me. Nice!

Not knowing much about how Excel performs Union of ranges, I testeted by
filling all 16,777,216 cells with the letter N and searched for N in every
cell. I thought the resulting range would have a whole slew of commas and
blow up but found Excel smartly consolidates the ranges, keeping the most
simplified address. Results shown below. Marvellous.

Iteration Aggregate Range
1 $B$1
2 $B$1:$C$1
....
254 $B$1:$IU$1
255 $B$1:$IV$1
256 $B$1:$IV$1,$A$2
257 $B$1:$IV$1,$A$2:$B$2
....
510 $B$1:$IV$1,$A$2:$IU$2
511 $B$1:$IV$1,$2:$2
512 $B$1:$IV$1,$2:$2,$A$3
513 $B$1:$IV$1,$2:$2,$A$3:$B$3
....
767 $B$1:$IV$1,$2:$3
....
16777214 $B$1:$IV$1,$2:$65535,$A$65536:$IU$65536
16777215 $B$1:$IV$1,$2:$65536 'Note: only
missing A1, but the code will go get it next!
16777216 $A$1:$IV$65536


-- Bill

"Jim Thomlinson" <[email protected]> wrote in message
news:[email protected]...
> You are close but give this a try...
>
> Public Sub CopyToComlete()
> Dim wksCopyTo As Worksheet
> Dim wksCopyFrom As Worksheet
> Dim rngCopyTo As Range
> Dim rngCopyFrom As Range
> Dim rngToSearch As Range
> Dim rngFirst As Range
> Dim rngCurrent As Range
>
> Set wksCopyTo = Sheets("Completed")
> Set rngCopyTo = wksCopyTo.Range("A65536").End(xlUp).Offset(1, 0)
>
> Set wksCopyFrom = Sheets("Project Report")
> Set rngToSearch = wksCopyFrom.Columns(2)
> Set rngCurrent = rngToSearch.Find("N")
>
> If rngCurrent Is Nothing Then
> MsgBox "N was not found"
> Else
> Set rngFirst = rngCurrent
> Set rngCopyFrom = rngCurrent
> Do
> Set rngCopyFrom = Union(rngCopyFrom, rngCurrent)
> Set rngCurrent = rngToSearch.FindNext(rngCurrent)
> Loop Until rngFirst.Address = rngCurrent.Address
> rngCopyFrom.EntireRow.Copy rngCopyTo
> rngCopyFrom.EntireRow.Delete
> End If
>
> End Sub
>
> --
> HTH...
>
> Jim Thomlinson
>
>
> "GregR" wrote:
>
>> Why does this code not work?
>>
>> Sub CopyToCompleted()
>> Dim rFrom As Range
>> Dim rTo As Range
>> Dim C As Long 'Column #
>> Dim R As Long 'Row #
>>
>> Set rTo = Sheets("Completed").Cells(Rows.Count, 1).End(xlUp)(1, 1)
>>
>> On Error Resume Next
>> C = [B1].Column
>>
>> Set rFrom = Sheets("Project Report").Range(Cells(3, C),
>> Cells(Rows.Count, C)).Find("N")
>> If Err.Number > 0 Then Exit Sub
>>
>> For Each R In rFrom
>> rFrom.EntireRow.Copy rTo
>> rFrom.EntireRow.Delete
>>
>> Next R
>> End Sub
>>
>> What I am trying to accomplish is move all the rows where column "B" in
>> Sheets("Project Report") ="N" to the next empty row in
>> Sheets("Completed"). TIA
>>
>> Greg
>>
>>

[GregR]

Jim and William thank you very much, both codes run very well. I have
less than 200 rows, so both are fast. I agree with William, Jim the
union code is very efficient. Thanks again

Greg