Copy Rows if Value is NOT Equal to...

D

drew27c

New Member
Joined
Aug 16, 2016
Messages
24
What am I doing wrong in the third loop? I want to copy rows if the value is not equal to one of the conditions in my IF statement. I don't get any errors, so my logic/ approach is def wrong. The first 2 loops work just fine.

Code: 
Sub copy_date()

Application.ScreenUpdating = False
Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long


'copy vr3
a = Worksheets("export").Cells(rows.Count, 1).End(xlUp).Row
For i = 2 To a
    If _
        Worksheets("export").Cells(i, 6).Value = "U054185" Or _
        Worksheets("export").Cells(i, 6).Value = "U054189" Or _
        Worksheets("export").Cells(i, 6).Value = "U054190" Then
        Worksheets("export").rows(i).Copy
        Worksheets("vr3").Activate
        b = Worksheets("vr3").Cells(rows.Count, 1).End(xlUp).Row
        Worksheets("vr3").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("export").Activate
    End If
Next


'copy vr2
c = Worksheets("export").Cells(rows.Count, 1).End(xlUp).Row
For i = 2 To c
    If _
        Worksheets("export").Cells(i, 6).Value = "U054181" Or _
        Worksheets("export").Cells(i, 6).Value = "U054182" Or _
        Worksheets("export").Cells(i, 6).Value = "U054183" Or _
        Worksheets("export").Cells(i, 6).Value = "U054184" Or _
        Worksheets("export").Cells(i, 6).Value = "U054186" Or _
        Worksheets("export").Cells(i, 6).Value = "U054187" Or _
        Worksheets("export").Cells(i, 6).Value = "U054188" Or _
        Worksheets("export").Cells(i, 6).Value = "U054191" Then
        Worksheets("export").rows(i).Copy
        Worksheets("vr2").Activate
        d = Worksheets("vr2").Cells(rows.Count, 1).End(xlUp).Row
        Worksheets("vr2").Cells(d + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("export").Activate
    End If
Next


'copy vr1
e = Worksheets("export").Cells(rows.Count, 1).End(xlUp).Row
For i = 2 To c
    If _
        Worksheets("export").Cells(i, 6).Value <> "U054181" Or _
        Worksheets("export").Cells(i, 6).Value <> "U054182" Or _
        Worksheets("export").Cells(i, 6).Value <> "U054183" Or _
        Worksheets("export").Cells(i, 6).Value <> "U054184" Or _
        Worksheets("export").Cells(i, 6).Value <> "U054185" Or _
        Worksheets("export").Cells(i, 6).Value <> "U054186" Or _
        Worksheets("export").Cells(i, 6).Value <> "U054187" Or _
        Worksheets("export").Cells(i, 6).Value <> "U054188" Or _
        Worksheets("export").Cells(i, 6).Value <> "U054189" Or _
        Worksheets("export").Cells(i, 6).Value <> "U054190" Or _
        Worksheets("export").Cells(i, 6).Value <> "U054191" Then
        Worksheets("export").rows(i).Copy
        Worksheets("vr1").Activate
        f = Worksheets("vr2").Cells(rows.Count, 1).End(xlUp).Row
        Worksheets("vr1").Cells(f + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("export").Activate
    End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
In the 3rd one your f variable uses vr2 worksheet. Is that meant to be vr1?
 
Upvote 0
Added to what Steve has said, for the 3rd loop I suspect that you need to change your Or to And
 
Upvote 0
You both are right. Thanks so much. Working code as follows:

Code: 
Sub copydata()

Application.ScreenUpdating = False
Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long


'copy vr3
a = Worksheets("export").Cells(rows.Count, 1).End(xlUp).Row
For i = 2 To a
    If _
        Worksheets("export").Cells(i, 6).Value = "U054185" Or _
        Worksheets("export").Cells(i, 6).Value = "U054189" Or _
        Worksheets("export").Cells(i, 6).Value = "U054190" Then
        Worksheets("export").rows(i).Copy
        Worksheets("vr3").Activate
        b = Worksheets("vr3").Cells(rows.Count, 1).End(xlUp).Row
        Worksheets("vr3").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("export").Activate
    End If
Next


'copy vr2
c = Worksheets("export").Cells(rows.Count, 1).End(xlUp).Row
For i = 2 To c
    If _
        Worksheets("export").Cells(i, 6).Value = "U054181" Or _
        Worksheets("export").Cells(i, 6).Value = "U054182" Or _
        Worksheets("export").Cells(i, 6).Value = "U054183" Or _
        Worksheets("export").Cells(i, 6).Value = "U054184" Or _
        Worksheets("export").Cells(i, 6).Value = "U054186" Or _
        Worksheets("export").Cells(i, 6).Value = "U054187" Or _
        Worksheets("export").Cells(i, 6).Value = "U054188" Or _
        Worksheets("export").Cells(i, 6).Value = "U054191" Then
        Worksheets("export").rows(i).Copy
        Worksheets("vr2").Activate
        d = Worksheets("vr2").Cells(rows.Count, 1).End(xlUp).Row
        Worksheets("vr2").Cells(d + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("export").Activate
    End If
Next


'copy vr1
e = Worksheets("export").Cells(rows.Count, 1).End(xlUp).Row
For i = 2 To e
    If _
        Worksheets("export").Cells(i, 6).Value <> "U054181" And _
        Worksheets("export").Cells(i, 6).Value <> "U054182" And _
        Worksheets("export").Cells(i, 6).Value <> "U054183" And _
        Worksheets("export").Cells(i, 6).Value <> "U054184" And _
        Worksheets("export").Cells(i, 6).Value <> "U054185" And _
        Worksheets("export").Cells(i, 6).Value <> "U054186" And _
        Worksheets("export").Cells(i, 6).Value <> "U054187" And _
        Worksheets("export").Cells(i, 6).Value <> "U054188" And _
        Worksheets("export").Cells(i, 6).Value <> "U054189" And _
        Worksheets("export").Cells(i, 6).Value <> "U054190" And _
        Worksheets("export").Cells(i, 6).Value <> "U054191" Then
        Worksheets("export").rows(i).Copy
        Worksheets("vr1").Activate
        f = Worksheets("vr1").Cells(rows.Count, 1).End(xlUp).Row
        Worksheets("vr1").Cells(f + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("export").Activate
    End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Looking at it you could combine those loops. See if this works:

Code: 
For i = 2 To Worksheets("export").Cells(Rows.Count, 6).End(xlUp).Row
    Select Case Worksheets("export").Cells(i, 6).Value
        Case "U054185", "U054189", "U054190"
            Worksheets("export").Rows(i).Copy Worksheets("vr3").Cells(Worksheets("vr3").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
            
        Case "U054181", "U054182", "U054183", "U054184", "U054186", "U054187", "U054188", "U054191"
            Worksheets("export").Rows(i).Copy Worksheets("vr2").Cells(Worksheets("vr2").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
            
        Case Else
            Worksheets("export").Rows(i).Copy Worksheets("vr1").Cells(Worksheets("vr1").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
    End Select
Next
 
Upvote 0
steve the fish said:
Looking at it you could combine those loops. See if this works:

Code: 
For i = 2 To Worksheets("export").Cells(Rows.Count, 6).End(xlUp).Row
    Select Case Worksheets("export").Cells(i, 6).Value
        Case "U054185", "U054189", "U054190"
            Worksheets("export").Rows(i).Copy Worksheets("vr3").Cells(Worksheets("vr3").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
            
        Case "U054181", "U054182", "U054183", "U054184", "U054186", "U054187", "U054188", "U054191"
            Worksheets("export").Rows(i).Copy Worksheets("vr2").Cells(Worksheets("vr2").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
            
        Case Else
            Worksheets("export").Rows(i).Copy Worksheets("vr1").Cells(Worksheets("vr1").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
    End Select
Next
Click to expand...

Its perfect and so much more elegant. Thank you sir.
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
Copy Paste from one Workbook to another
Replies
1
Views
207
rollis13
rollis13
J
  • Solved
Code to copy over row if certain criteria is met
2
Replies
18
Views
556
mumps
mumps
tabbytomo
  • Solved
Copy entire row if cell has specific value, looking at multiple columns and worksheets.
Replies
2
Views
280
NateSC
NateSC
I
  • Solved
Set value for range being copied over with VBA
2
Replies
14
Views
170
ItalianPlatinum
I
B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
1
Views
193
bobaol
B

Forum statistics

Threads
1,214,636
Messages
6,120,669
Members
448,977
Latest member
moonlight6

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top