macro to copy rows that contain a cell with a certain number

C

CYaYa

Good morning,

I have recorded the macro below and need to expand it's capabilities.
It's a mixture of recording key strokes and inserting code I found on this
site. So I know there are some things in the macro that probably do nothing.
With that said the macro performs what I need it to as it is recorded now.
However I would like to have it do the following after what it is already
doing:

Go back to the sheet named "Current unapplied" and if cell L = 0 have it
copy the entire row and paste it in the sheet named "unapplied Copy" in the
next available blank row. Every week the information in the two sheets are
variable.

I tried to use the same code that deletes the rows in "Unapplied copy"
where cell L = 0 but I get an error message. So any help that can be provided
will be greatly appreciated. Thanks.

Chad

Sub Macro3()
'
' Macro3 Macro
'

'
Sheets("Current Unapplied").Select
Range("J2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC[-3])"
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
Selection.AutoFill Destination:=Range("J2:J703"), Type:=xlFillDefault
Range("J2:J703").Select
ActiveWindow.ScrollRow = 679
ActiveWindow.ScrollRow = 544
ActiveWindow.ScrollRow = 272
ActiveWindow.ScrollRow = 1
Range("K2").Select
ActiveCell.FormulaR1C1 = "1"
Range("K3").Select
ActiveCell.FormulaR1C1 = "2"
Range("K4").Select
ActiveCell.FormulaR1C1 = "3"
Range("K2:K4").Select
Selection.AutoFill Destination:=Range("K2:K703")
Range("K2:K703").Select
Sheets("Unapplied Copy").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
Range("J2").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC[-3])"
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
Selection.AutoFill Destination:=Range("J2:J722"), Type:=xlFillDefault
Range("J2:J722").Select
ActiveWindow.ScrollRow = 661
ActiveWindow.ScrollRow = 397
ActiveWindow.ScrollRow = 265
ActiveWindow.ScrollRow = 133
ActiveWindow.ScrollRow = 1
Range("K2").Select
ActiveCell.FormulaR1C1 = "1"
Range("K3").Select
ActiveCell.FormulaR1C1 = "2"
Range("K4").Select
ActiveCell.FormulaR1C1 = "3"
Range("K2:K4").Select
Selection.AutoFill Destination:=Range("K2:K722")
Range("K2:K722").Select
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-2],'Current Unapplied'!RC[-2]:RC[-1],2,FALSE)"
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)),d,(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)))"
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L722")
Range("L2:L722").Select
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)),_delete,(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)))"
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L722")
Range("L2:L722").Select
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)),0,(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)))"
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L722")
Range("L2:L722").Select
Range("L2").Select
Sheets("Current Unapplied").Select
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-2],'Unapplied Copy'!RC[-2]:RC[-1],2,FALSE)"
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-2],'Unapplied
Copy'!R2C10:R5000C11,2,FALSE)),0,(VLOOKUP(RC[-2],'Unapplied
Copy'!R2C10:R5000C11,2,FALSE)))"
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L703")
Range("L2:L703").Select
Range("L2").Select
Sheets("Unapplied Copy").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A2").Select
Dim MyRange, MyRange1 As Range
lastrow = Cells(Rows.Count, "l").End(xlUp).Row
Set MyRange = Sheets("Unapplied Copy").Range("l1:l" & lastrow)
For Each c In MyRange
If UCase(c.Value) = "0" Then
If MyRange1 Is Nothing Then
Set MyRange1 = c.EntireRow
Else
Set MyRange1 = Union(MyRange1, c.EntireRow)
End If
End If
Next
If Not MyRange1 Is Nothing Then
MyRange1.Delete
End If
Sheets("Current Unapplied").Select
Sheets("Unapplied Copy").Activate
mlastrow = Cells(Rows.Count, "A").End(xlUp).Row
Cells(mlastrow + 1, "A").Activate

End Sub
 
P

Per Jessen

Hello Chad,

I cleanded up your code a bit and inserted a copy routine as you asked
for (not testet).

Watch out for word wrap in the formula lines!

This should do it:

Sub Macro3()
'
' Macro3 Macro
'
Dim MyRange, MyRange1 As Range
Dim LastRow As Long
Application.ScreenUpdating = False
Sheets("Current Unapplied").Select
Range("J2").FormulaR1C1 = _
"=CONCATENATE(RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC[-3])"
Range("J2:J703").FillDown
Range("K2") = "1"
Range("K3") = "2"
Range("K4") = "3"
Range("K2:K4").AutoFill Destination:=Range("K2:K703")

Sheets("Unapplied Copy").Select
Range("J2").FormulaR1C1 = _
"=CONCATENATE(RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC[-3])"

Range("J2:J722").FillDown
Range("K2") = "1"
Range("K3") = "2"
Range("K4") = "3"
Range("K2:K4").AutoFill Destination:=Range("K2:K722")
Range("L2").FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-2],'Current Unapplied '!
R2C10:R5000C11,2,FALSE)),0,(VLOOKUP(RC[-2],'Current Unapplied '!
R2C10:R5000C11,2,FALSE)))"
Range("L2").AutoFill Destination:=Range("L2:L722")

Sheets("Current Unapplied").Select
Range("L2").FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-2],'Unapplied Copy '!
R2C10:R5000C11,2,FALSE)),0,(VLOOKUP(RC[-2],'Unapplied Copy '!
R2C10:R5000C11,2,FALSE)))"
Range("L2").AutoFill Destination:=Range("L2:L703")

Sheets("Unapplied Copy").Select
LastRow = Cells(Rows.Count, "L").End(xlUp).Row
Set MyRange = Sheets("Unapplied Copy").Range("L2:L" & LastRow)
For Each c In MyRange
If c.Value = 0 Then
If MyRange1 Is Nothing Then
Set MyRange1 = c.EntireRow
Else
Set MyRange1 = Union(MyRange1, c.EntireRow)
End If
End If
Next
If Not MyRange1 Is Nothing Then
MyRange1.Delete
End If
Sheets("Current Unapplied").Select
LastRow = Cells(Rows.Count, "L").End(xlUp).Row
Set MyRange = Range("L2:L" & LastRow)
For Each c In MyRange
If c.Value = 0 Then
c.EntireRow.Copy Sheets("Unapplied Copy").Range("A" &
Rows.Count).End(xlUp).Offset(1, 0)
End If
Next
Application.ScreenUpdating = True
End Sub

Regards,
Per


Good morning,

    I have recorded the macro below and need to expand it's capabilities.
It's a mixture of recording key strokes and inserting code I found on this
site. So I know there are some things in the macro that probably do nothing.
With that said the macro performs what I need it to as it is recorded now..
However I would like to have it do the following after what it is already
doing:

    Go back to the sheet named "Current unapplied" and if cell L = 0 have it
copy the entire row and paste it in the sheet named "unapplied Copy" in the
next available blank row. Every week the information in the two sheets are
variable.

     I tried to use the same code that deletes the rows in "Unapplied copy"
where cell L = 0 but I get an error message. So any help that can be provided
will be greatly appreciated. Thanks.

  Chad    

Sub Macro3()
'
' Macro3 Macro
'

'
    Sheets("Current Unapplied").Select
    Range("J2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC[-3])"
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    Selection.AutoFill Destination:=Range("J2:J703"), Type:=xlFillDefault
    Range("J2:J703").Select
    ActiveWindow.ScrollRow = 679
    ActiveWindow.ScrollRow = 544
    ActiveWindow.ScrollRow = 272
    ActiveWindow.ScrollRow = 1
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("K3").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("K4").Select
    ActiveCell.FormulaR1C1 = "3"
    Range("K2:K4").Select
    Selection.AutoFill Destination:=Range("K2:K703")
    Range("K2:K703").Select
    Sheets("Unapplied Copy").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    Range("J2").Select
    ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC[-3])"
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    Selection.AutoFill Destination:=Range("J2:J722"), Type:=xlFillDefault
    Range("J2:J722").Select
    ActiveWindow.ScrollRow = 661
    ActiveWindow.ScrollRow = 397
    ActiveWindow.ScrollRow = 265
    ActiveWindow.ScrollRow = 133
    ActiveWindow.ScrollRow = 1
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("K3").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("K4").Select
    ActiveCell.FormulaR1C1 = "3"
    Range("K2:K4").Select
    Selection.AutoFill Destination:=Range("K2:K722")
    Range("K2:K722").Select
    Range("L2").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-2],'Current Unapplied'!RC[-2]:RC[-1],2,FALSE)"
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)),d,(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)))"
    Range("L2").Select
    Selection.AutoFill Destination:=Range("L2:L722")
    Range("L2:L722").Select
    Range("L2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)),_delete,(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)))"
    Range("L2").Select
    Selection.AutoFill Destination:=Range("L2:L722")
    Range("L2:L722").Select
    Range("L2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)),0,(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)))"
    Range("L2").Select
    Selection.AutoFill Destination:=Range("L2:L722")
    Range("L2:L722").Select
    Range("L2").Select
    Sheets("Current Unapplied").Select
    Range("L2").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-2],'Unapplied Copy'!RC[-2]:RC[-1],2,FALSE)"
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(RC[-2],'Unapplied
Copy'!R2C10:R5000C11,2,FALSE)),0,(VLOOKUP(RC[-2],'Unapplied
Copy'!R2C10:R5000C11,2,FALSE)))"
    Range("L2").Select
    Selection.AutoFill Destination:=Range("L2:L703")
    Range("L2:L703").Select
    Range("L2").Select
    Sheets("Unapplied Copy").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A2").Select
    Dim MyRange, MyRange1 As Range
lastrow = Cells(Rows.Count, "l").End(xlUp).Row
Set MyRange = Sheets("Unapplied Copy").Range("l1:l" & lastrow)
For Each c In MyRange
   If UCase(c.Value) = "0" Then
        If MyRange1 Is Nothing Then
            Set MyRange1 = c.EntireRow
        Else
            Set MyRange1 = Union(MyRange1, c.EntireRow)
        End If
    End If
Next
If Not MyRange1 Is Nothing Then
MyRange1.Delete
End If
Sheets("Current Unapplied").Select
Sheets("Unapplied Copy").Activate
mlastrow = Cells(Rows.Count, "A").End(xlUp).Row
Cells(mlastrow + 1, "A").Activate

End Sub
Click to expand...
 
C

CYaYa

Hi Simon,

This code works with one big exception. If I have a row where cell L = 0 and
the other cells of that row are the same as another row where cell L = 0
(except for cell K as this cell is never going to be a duplicte as it just
counts the rows of data) it only copies one of the rows to the unapplied copy
sheet. Is there a way to get it to copy those rows. If needed i can put
together a small sample workbook for you. Thanks.

Chad

Simon Lloyd said:
Not tested but this should do what you need:

Code:
--------------------
Dim Rng As Range, MyCell As Range
Set Rng = Sheets("Current unapplied").Range("L1:L" & Sheets("Current unapplied").Range("L" & Rows.Count).End(xlUp).Row)
For Each MyCell In Rng
If MyCell.Value = 0 Then
MyCell.EntireRow.Copy Destination:=Sheets("Unapplied copy").Range("L" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next MyCell

--------------------


CYaYa;508300 said:
Good morning,

I have recorded the macro below and need to expand it's capabilities.
It's a mixture of recording key strokes and inserting code I found on
this
site. So I know there are some things in the macro that probably do
nothing.
With that said the macro performs what I need it to as it is recorded
now.
However I would like to have it do the following after what it is
already
doing:

Go back to the sheet named "Current unapplied" and if cell L = 0 have
it
copy the entire row and paste it in the sheet named "unapplied Copy" in
the
next available blank row. Every week the information in the two sheets
are
variable.

I tried to use the same code that deletes the rows in "Unapplied copy"
where cell L = 0 but I get an error message. So any help that can be
provided
will be greatly appreciated. Thanks.

Chad
Code:
--------------------Sub Macro3()
'
' Macro3 Macro
'

'
Sheets("Current Unapplied").Select
Range("J2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC[-3])"
Selection.AutoFill Destination:=Range("J2:J703"), Type:=xlFillDefault
Range("J2:J703").Select
Range("K2").Select
ActiveCell.FormulaR1C1 = "1"
Range("K3").Select
ActiveCell.FormulaR1C1 = "2"
Range("K4").Select
ActiveCell.FormulaR1C1 = "3"
Range("K2:K4").Select
Selection.AutoFill Destination:=Range("K2:K703")
Range("K2:K703").Select
Sheets("Unapplied Copy").Select
Range("J2").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC[-3])"
Selection.AutoFill Destination:=Range("J2:J722"), Type:=xlFillDefault
Range("J2:J722").Select
Range("K2").Select
ActiveCell.FormulaR1C1 = "1"
Range("K3").Select
ActiveCell.FormulaR1C1 = "2"
Range("K4").Select
ActiveCell.FormulaR1C1 = "3"
Range("K2:K4").Select
Selection.AutoFill Destination:=Range("K2:K722")
Range("K2:K722").Select
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-2],'Current Unapplied'!RC[-2]:RC[-1],2,FALSE)"
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)),d,(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)))"
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L722")
Range("L2:L722").Select
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)),_delete,(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)))"
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L722")
Range("L2:L722").Select
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)),0,(VLOOKUP(RC[-2],'Current
Unapplied'!R2C10:R5000C11,2,FALSE)))"
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L722")
Range("L2:L722").Select
Range("L2").Select
Sheets("Current Unapplied").Select
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-2],'Unapplied Copy'!RC[-2]:RC[-1],2,FALSE)"
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-2],'Unapplied
Copy'!R2C10:R5000C11,2,FALSE)),0,(VLOOKUP(RC[-2],'Unapplied
Copy'!R2C10:R5000C11,2,FALSE)))"
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L703")
Range("L2:L703").Select
Sheets("Unapplied Copy").Select
Range("A2").Select
Dim MyRange, MyRange1 As Range
lastrow = Cells(Rows.Count, "l").End(xlUp).Row
Set MyRange = Sheets("Unapplied Copy").Range("l1:l" & lastrow)
For Each c In MyRange
If UCase(c.Value) = "0" Then
If MyRange1 Is Nothing Then
Set MyRange1 = c.EntireRow
Else
Set MyRange1 = Union(MyRange1, c.EntireRow)
End If
End If
Next
If Not MyRange1 Is Nothing Then
MyRange1.Delete
End If
Sheets("Current Unapplied").Select
Sheets("Unapplied Copy").Activate
mlastrow = Cells(Rows.Count, "A").End(xlUp).Row
Cells(mlastrow + 1, "A").Activate

End Sub

--------------------
Click to expand...


--
Simon Lloyd

Regards,
Simon Lloyd
'Microsoft Office Help' (http://www.thecodecage.com)
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Macro that deletes and pastes filterd rows and then some 2
fixing a run-time error'9': Subscript out of range 0
"=TEXT(RC[-1],"MMM")" 4
File Name changes with dates and Deleting Rows of Zeros 0
same macro on multiple sheets 4
Advanced Filter works in recorder but not while running macro 5
run macro text missing 1
Macros--user choices 2

Top