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

 

[Guest]

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

 

[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

 

[Guest]

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)

 

[Guest]

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

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

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 ;-)

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

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

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

 

[Guest]

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

Jim Thomlinson

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 ;-)

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

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


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

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

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