Efficient ways to copy row based on condition

[srosk]

I have data stored on main sheet [Sheet1]. There are 4 other sheets on the spreadsheet. [Sheet 2] [Sheet 3] [Sheet 4] [Sheet 5]

I would like to copy the header (row 1) and data to copy to Sheet 2 from Sheet 1 if Sheet 1 column AA = 1; to Sheet 3 if Sheet 1 AB = 1, to Sheet 3 if Sheet 1 AC = 1, and to Sheet 4 if Sheet 1 AD =1.

I have code to delete specific columns for individual sheets... but I need to somehow get the data there. I read something about auto filter, but do not know how to apply.

Looking for the most efficient way to do this. Thank you!!

 

[My Aswer Is This]

Are you saying if any cell in column AA do this for example?
You Said AA so I assume you mean any cell in column AA and the other columns also.

Now I maybe could provide a script. But if you need the Most efficient.
I probable could not do that. There are a lot of other people on this forum who may be able to do the Most efficient code.

I will continue to monitor this thread

 

[Michael M]

I don't know about most efficient, but try....

Sub MM1()
Application.ScreenUpdating = False
For x = 1 To 4
With Columns(x + 26)
    .AutoFilter field:=1, Criteria1:=1
    .SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet" & x + 1).Range("A1")
    .AutoFilter
End With
Next x
Application.ScreenUpdating = True
End Sub

 

[srosk]

It would be on a per row basis.

So if AA2 = 1, copy row to Sheet 2.. if AB2=1, copy row to Sheet 3.. if AB3 = blank, do nothing.. if AB4 = 1 copy to Sheet 3.

The way my script works now, is it copies everything from Sheet 1 to Sheet 2, 3, 4, and 5. From there, based on AA/AB/AC/AD value, it will delete any row where the specific cell <>1. Current state works, however... I will sometimes have over 100k records, and it takes a significant amount of time to run > 25 minutes. I think due to repeating the 'loop' process on so many sheets. Thank you for your help!

 

[srosk]

Thank you! So the sheet names aren't actually Sheet 1/2/3, but instead something like 'Data Report' (main feed), Date Data, Address Data, etc. How can I work that into the code?

Can you let me know if I understand correctly? Currently what you wrote will look at x 1-4. When X=1, it will filter column AB looking for 1, and copy the rows. Then copy to Sheet 2. X=2, AC / Sheet 3. Where it says .SpecialCells, would I just update to:

If X = 1 Then .SpecialCells(xlCellTypeVisible).Copy Sheets("Date Dta").Range("A1")

Thank you all for your help... what a great resource and learning opportunity!

I don't know about most efficient, but try....

Sub MM1()
Application.ScreenUpdating = False
For x = 1 To 4
With Columns(x + 26)
    .AutoFilter field:=1, Criteria1:=1
    .SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet" & x + 1).Range("A1")
    .AutoFilter
End With
Next x
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

You said:

It would be on a per row basis.

So if AA2 = 1, copy row to Sheet 2.. if AB2=1, copy row to Sheet 3.. if AB3 = blank, do nothing.. if AB4 = 1 copy to Sheet 3.

AA2 Means Column AA Row 2
AB2 Means Column AB Row 2

So this seems to me to always be the same row but different columns

If that what you mean.
​

 

[srosk]

This is working but only copies value in column AA / AB / AC, etc. Is it possible to copy all columns with a value over.. ie A:AZ? Thank you!

I don't know about most efficient, but try....

Sub MM1()
Application.ScreenUpdating = False
For x = 1 To 4
With Columns(x + 26)
    .AutoFilter field:=1, Criteria1:=1
    .SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet" & x + 1).Range("A1")
    .AutoFilter
End With
Next x
Application.ScreenUpdating = True
End Sub

 

[srosk]

Code only copies one column

Hi there. I have the following code, but it only copies column AA / AB / AC depending on the value of X. How do I get it to copy all columns in the row?

Sub MM1()
Application.ScreenUpdating = False
For x = 1 To 4
With Columns(x + 26)
    .AutoFilter field:=1, Criteria1:=1
    .SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet" & x + 1).Range("A1")
    .AutoFilter
End With
Next x
Application.ScreenUpdating = True
End Sub

Thanks!

 

[Fluff]

Re: Code only copies one column

Try

.SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Sheet" & x + 1).Range("A1")

 

[srosk]

Re: Code only copies one column

Thanks. I had to change the original code, because the sheet names will be different. So I tried your code and it says Invalid or Unqualified reference. When I remove the period.. the sub is undefined...

Thoughts?

Sub MM1()
Application.ScreenUpdating = False
    Selection.AutoFilter Field:=(27), Criteria1:="1"
    .SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Vesting").Range("A1")
Application.ScreenUpdating = True
End Sub