Thread: VB - Copy all rows with certain criteria

I have this code started - so far it works except it only copies ONE row (the first one), and I need it to copy ALL the rows where "B" contains "8852"

Thanks for all the help - you guys are great!

Code:

Sub Divide()
Dim LR As Long
    If MsgBox("Complete this action?", vbYesNo) = vbYes Then
RemovePR = Range("I" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
    For A = RemovePR To 1 Step -1
        If Cells(A, "I").Value = "PR" Then Rows(A).Delete (xlShiftUp)
    Next A
        Range("A1") = 1
        Range("A2") = 2
        LR = Range("B" & Rows.Count).End(xlUp).Row
        Range("A1:A2").AutoFill Destination:=Range("A1:A" & LR)
CopyKits = Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
    For C = CopyKits To 1 Step -1
        If Cells(C, "B").Value = "8852" Then Rows(C).Copy
    Next C
End If
End Sub

I attached an example of what I have so far. The red part is what I need to alter.

adgjqetuo,

Where are you copying the rows to?


You may want to consider moving your macro code to a Module.

Update to your code so far:

Code:

Option Explicit
Sub Divide()
Dim LR As Long, CopyKits As Long, RemovePR As Long, A As Long, C As Long
If MsgBox("Complete this action?", vbYesNo) = vbYes Then
  RemovePR = Range("I" & Rows.Count).End(xlUp).Row
  Application.ScreenUpdating = False
  For A = RemovePR To 1 Step -1
    If Cells(A, "I").Value = "PR" Then Rows(A).Delete (xlShiftUp)
  Next A
  Range("A1") = 1
  Range("A2") = 2
  LR = Range("B" & Rows.Count).End(xlUp).Row
  Range("A1:A2").AutoFill Destination:=Range("A1:A" & LR)
  CopyKits = Range("B" & Rows.Count).End(xlUp).Row
  Application.ScreenUpdating = False
  For C = CopyKits To 1 Step -1
    If Cells(C, "B").Value = "8852" Then Rows(C).Copy
  Next C
End If
End Sub

Copying doesn't require a loop at all in datasets like this, an Autofilter can grab all the matching rows at once and copy them.

So, why don't you post a REAL data sample and not this stripped down stuff, and don't forget the most important part of a "copy" question...where you want to COPY TO! Oops.

Perhaps on the sheet you're going to post, mockup before/after so it's really clear.

Lastly, on the macro so far, you don't have to keep declaring new variables for loops and LASTROW, you can reuse the ones you're done with.

Code:

Option Explicit

Sub Divide()
Dim LR As Long, i As Long

If MsgBox("Complete this action?", vbYesNo) = vbYes Then
    LR = Range("I" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    
    For i = LR To 1 Step -1
        If Cells(i, "I").Value = "PR" Then Rows(i).Delete (xlShiftUp)
    Next i
        
    Range("A1") = 1
    Range("A2") = 2
    LR = Range("B" & Rows.Count).End(xlUp).Row
    Range("A1:A2").AutoFill Destination:=Range("A1:A" & LR)

    LR = Range("B" & Rows.Count).End(xlUp).Row
    
    For i = LR To 1 Step -1
        If Cells(i, "B").Value = "8852" Then Rows(i).Copy 'Copy to where?? (should use an autofilter here instead)
    Next i
            
End If
    
    Application.ScreenUpdating = True
End Sub

Also, your code was in the wrong module.

hi,

I typed this up when there were no responses & have just seen JB's + Stanley's as I previewed my post, since I've typed it - here it is...


I'm off to bed now, & so I'm not going to give you a complete answer but I will look at it again in the morning (hopefully someone else can help you before then...?). If you want to try solving it yourself have a look at the below links:

Deleting Rows:
http://www.excelforum.com/excel-prog...ts-in-vba.html
http://www.ozgrid.com/VBA/row-delete-criteria.htm
Range of solutions:
http://www.excelforum.com/excel-prog...ts-in-vba.html

Copying info:
http://www.tech-archive.net/Archive/.../msg00572.html


hth
Rob

Hey Sorry - i'm new to this VB stuff...

It actually has to CUT into a new excel workbook. All the 8852 rows into one workbook, all the 8853 rows into another...etc. I said copy originally because thats how i was testing it - my appologies.

I was hoping to get it to work for the 8852s and then just mirror it down for the rest of the codes? There are as much as 10 somedays, and 1-2 other days. So I was hoping to get it to work no matter how many are available by bypassing the error.

The sample attachment was just for testing purposes. I can't send over the real file as it's a confidential work file.

And no - I can't use auto filter - the original file is automated via email. I was planning on pasting this code into my PERSONAL section so I can use it to quickly divy out the accounts rather then having to do it manually everyday.


Also - the section of the code that deletes the "PR" is so it deletes out any rows that contain PR in column "I" before numbering (unique identifer) and sorting out.

adgjqetuo,

Try this free Excel addin:

Excel Explosion 3.0 (free addin) at:
http://www.datapigtechnologies.com/freeware.htm
View the demo.