Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code not working
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code not working
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code not working
Jim, I need to exclude row 1 and 2 (header rows) from the "CopyFrom"
range. TIA Greg |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code not working
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(xlCellT ypeLastCell) rFrom.Copy .Offset(-CInt(Sheets("Completed").UsedRange.SpecialCells(xl CellTypeLastCell). _ 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" wrote in message ups.com... 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code not working
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code not working
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(xlCellT ypeLastCell) rFrom.Copy .Offset(-CInt(Sheets("Completed").UsedRange.SpecialCells(xl CellTypeLastCell). _ 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" wrote in message ups.com... 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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code not working
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" wrote in message ... 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(xlCellT ypeLastCell) rFrom.Copy .Offset(-CInt(Sheets("Completed").UsedRange.SpecialCells(xl CellTypeLastCell). _ 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" wrote in message ups.com... 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 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code not working
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" wrote in message ... 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(xlCellT ypeLastCell) rFrom.Copy .Offset(-CInt(Sheets("Completed").UsedRange.SpecialCells(xl CellTypeLastCell). _ 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" wrote in message ups.com... 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 |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code not working
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" wrote in message ... 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 |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code not working
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Wht is this Code not Working ? | Excel Programming | |||
VBA code not working... | Excel Programming | |||
Vb Code not working | Excel Programming | |||
Code not Working - Help please | Excel Programming | |||
why this code not working | Excel Programming |