VBA copy and paste rows in the same sheet based on criteria

Kazdima

Board Regular
Joined
Oct 15, 2010
Messages
226
Hello,
I have a data in a sheet name "Table" columns from A:I with rows from 1 to 500.
In row 1 from A:I are title names (A1=Owner, B=Account, C=Account Name, D=Amount, E=Type, F=End Date, G=Close Dat, H=posted, I=Paid/Unpaid.
I need to build a Macro to loop through different names in column A and based on criteria in column I "Unpaid"
copy all rows in the same sheet starting from row 520.

I looked at different examples of VBAs and could not find a working example.
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

Kazdima

Board Regular
Joined
Oct 15, 2010
Messages
226
HI,
this is an example of VBA I have but it does not work for me. Can you edit it?
Sub CopyCells()


Application.ScreenUpdating = False


Dim i As Integer


Dim Lastrow As Long


'Declaring variables


Dim rng As Range


Set rng = Range("A500:I500" & Lastrow)


Lastrow = Cells(Rows.Count, "A").End(xlUp).Row


For i = 1 To Lastrow


If Cells(i, 9).Value = "Unpaid" Then


Cells(i, 1).Value = Cells(i, 1).Value


Cells(i, 2).Value = Cells(i, 2).Value


Cells(i, 3).Value = Cells(i, 3).Value


Cells(i, 4).Value = Cells(i, 4).Value


Cells(i, 5).Value = Cells(i, 5).Value


Cells(i, 6).Value = Cells(i, 6).Value


Cells(i, 7).Value = Cells(i, 7).Value


Cells(i, 8).Value = Cells(i, 8).Value


Cells(i, 9).Value = Cells(i, 9).Value


End If


Next
 

smozgur

BatCoder
Joined
Feb 28, 2002
Messages
1,416
If I understand you correctly:
Main data:
Book1
ABCDEFGHI
1OwnerAccountAccount NameAmountTypeEnd DateClose DatePostedPaid/Unpaid
2aAccount-aAccount Name-aAmount-aType-aEnd Date-aClose Date-aPosted-aUnpaid
3bAccount-bAccount Name-bAmount-bType-bEnd Date-bClose Date-bPosted-bPaid
4cAccount-cAccount Name-cAmount-cType-cEnd Date-cClose Date-cPosted-cUnpaid
5dAccount-dAccount Name-dAmount-dType-dEnd Date-dClose Date-dPosted-dUnpaid
6
Sheet1

And you want to copy unpaid records starting from A520 on the same worksheet (so, the assumption is the main data never reaches cell A520).
Book1
ABCDEFGHI
520aAccount-aAccount Name-aAmount-aType-aEnd Date-aClose Date-aPosted-aUnpaid
521cAccount-cAccount Name-cAmount-cType-cEnd Date-cClose Date-cPosted-cUnpaid
522dAccount-dAccount Name-dAmount-dType-dEnd Date-dClose Date-dPosted-dUnpaid
Sheet1


if this is what you need, try the following code when the worksheet is the active one:

VBA Code:
Sub copyUnpaid()
Dim rng As Range
Dim cll As Range
Dim trg As Range
    With ActiveSheet
        Set rng = .Range(.Range("A2"), .Range("A2").End(xlDown)).Resize(, 9)
        If rng.Rows.Count + 1 >= 520 Then
            MsgBox "The source data list goes beyond A520. It is not something expected.", vbOKOnly + vbExclamation, "Error"
            Exit Sub
        End If
        Set trg = .Range("A520:I520")
        For Each cll In rng.Rows
            If cll.Cells(, 9).Value = "Unpaid" Then
                trg.Value = cll.Value
                Set trg = trg.Offset(1)
            End If
        Next cll
    End With
End Sub

Note 1: If you post some sample data, preferably by using XL2BB as I did above, I am sure you'll receive faster replies to your questions.

Note 2: You marked your last post as the solution to this question, and I removed it since it is not a solution. If you mark a post as a solution in your question thread, then the helpers will think that your question has been answered already by looking in the thread list. So, please only mark a post as the solution if you actually received an answer or posted your own solution.
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
1,091
Office Version
  1. 2013
Platform
  1. Windows
Hi other ideas
VBA Code:
Sub test()
    With Cells(1, 1).CurrentRegion
        .AutoFilter
        .AutoFilter Field:=9, Criteria1:="Unpaid"
        .Offset(1).Copy
        Cells(520, 1).PasteSpecial Paste:=xlPasteValues
    End With
    Application.CutCopyMode = False
End Sub
 

Kazdima

Board Regular
Joined
Oct 15, 2010
Messages
226

ADVERTISEMENT

Hello guys,
both Macros are working very good.
Is it possible to improve it? the copied data from row 520 can be sorted automatically by names in column A?
Thank you
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
1,091
Office Version
  1. 2013
Platform
  1. Windows
Hi
What about
VBA Code:
Sub test()
    Dim lr
    With Cells(1, 1).CurrentRegion
        .AutoFilter
        .AutoFilter Field:=9, Criteria1:="Unpaid"
        .Offset(1).Copy
        Cells(520, 1).PasteSpecial Paste:=xlPasteValues
    End With
    lr = Cells(520, 1).CurrentRegion.Rows.Count
    With ActiveSheet
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("A520:A" & lr + 520)
        With .Sort
            .SetRange Range("A520:I" & lr + 520)
            .Apply
        End With
    End With
    Application.CutCopyMode = False
End Sub
 

Kazdima

Board Regular
Joined
Oct 15, 2010
Messages
226

ADVERTISEMENT

Hello Mohadin, Macro is working but still it does sort alphabetically copied data starting in row 520.
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
1,091
Office Version
  1. 2013
Platform
  1. Windows
HI
It works Ok in hree!
Unless...
Book1
ABCDEFGHI
1OwnerAccountAccount NameAmountTypeEnd DateClose DatePostedPaid/Unpaid
2bAccount-bAccount Name-bAmount-bType-bEnd Date-bClose Date-bPosted-bPaid
3cAccount-cAccount Name-cAmount-cType-cEnd Date-cClose Date-cPosted-cUnpaid
4dAccount-dAccount Name-dAmount-dType-dEnd Date-dClose Date-dPosted-dUnpaid
5aAccount-aAccount Name-aAmount-aType-aEnd Date-aClose Date-aPosted-aUnpaid
Sheet1



Book1
ABCDEFGHI
520aAccount-aAccount Name-aAmount-aType-aEnd Date-aClose Date-aPosted-aUnpaid
521cAccount-cAccount Name-cAmount-cType-cEnd Date-cClose Date-cPosted-cUnpaid
522dAccount-dAccount Name-dAmount-dType-dEnd Date-dClose Date-dPosted-dUnpaid
Sheet1
 

Kazdima

Board Regular
Joined
Oct 15, 2010
Messages
226
Thank you, Mohadin. It does not sort , but the rest is working. I appreciate your help.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,167
Messages
5,640,540
Members
417,151
Latest member
ChickenTenderer

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
Top