Row search by criteria & copying data

[Juuljus]

Hi everyone,

I need to search for rows that meet a criteria (there are several rows
that meet that, and they all must be selected. The values are in column
no. 2) and after that copy those rows (to somewhere else in that
sheet). When copying the rows, only some columns must be taken. Some of
them are fixed, but some must be found by column name (criteria given).

Would be really nice if someone who has done something similare, would
give some help.

Juuljus

 

[Ron de Bruin]

Hi Juuljus

Use Autofilter for this

Filter on your citeria in column 2
Now do this

Ctrl-* to select all your data
Alt-; to select all visible cells
Ctrl-c to copy

Paste where you want

Or do you want to use code ?

 

[Juuljus]

Yes, it all has to be automatic. The user just clicks on a button and
everything is done for him/her.

 

[Ron de Bruin]

Hi Juuljus

This filter B1:B100 for Ron and copy to A110

Sub Copy_with_Autofilter()
Dim CopyValue As String
Dim rng As Range

CopyValue = "ron"
With ActiveSheet
.Range("B1:B100").AutoFilter Field:=1, Criteria1:=CopyValue
With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Copy Range("A110")

End With
.AutoFilterMode = False
End With
End Sub

 

[Juuljus]

Thanks Ron,

It works fine.
The problem is, that it only copies the last matching row.

Juuljus

 

[Ron de Bruin]

The problem is, that it only copies the last matching row.
??

What do you mean with this

 

[Juuljus]

I need to search for "customer"

there are 2-6 rows (different files have different numbers) with
customer. Lets take we have 2 customer rows, it only copies the last
match. The first customer is not copied.

 

[Ron de Bruin]

Strange

Can you send me your test workbook private

 

[Juuljus]

I'm afraid not, I'm working on real financial numbers for my company.

I changed the code a little, maybe that's what is messing it up.

Dim CopyValue As String
Dim rng As Range
CopyValue = "Customer"
With Worksheets("Temp")
.Range("B11:B40").AutoFilter Field:=1, Criteria1:=CopyValue
With Worksheets("Temp").AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Copy
Worksheets("Temp").Range("A45")


End With
.AutoFilterMode = False
End With

I'm quite sure the problem lies here: Worksheets("Temp").Range("A45")

 

[Ron de Bruin]

Hi Juuljus

Test it again and it is working correct

Note: B11 is a header cell ans will not be used

If you do it manual like I show you in this thread is it working then ?

 

[Juuljus]

Hi,

Google gives me errors. Can't replay it the thread.
Yes the problem was B11, I found that also myself.
But another problem rised up. I need to do the same thing for "Process"
and "Eployees". I copied the code and put the right parameters. Now it
copies customer rows, after that process rows + the customer rows and
for last employees rows + also customer rows. Any ideas? I could
understand if also process rows were in the employees field, but that
way it looks strange to me.

Big thanks to you Ron, you have helped me a lot!

 

[Ron de Bruin]

Hi

AutoFilter can only have two criteria so you have to run the macro in a loop or use AdvancedFilter.
with AdvancedFilter you must enter the criteria in range in the worksheet(you can hide that range)

See
http://www.contextures.com/xladvfilter01.html#ApplyAF

Record a macro when you do follow the steps

 

[Ron de Bruin]

You can Try this Autofilter loop

Sub Copy_with_Autofilter_Array()
Dim Rng As Range
Dim I As Long
Dim myArr As Variant

myArr = Array("Customer", "Process", "Employees")
Worksheets("Temp").Range("B45").Value = "Start Copy data"

For I = LBound(myArr) To UBound(myArr)
Worksheets("Temp").Range("B11:B40").AutoFilter Field:=1, Criteria1:=myArr(I)
With Worksheets("Temp").AutoFilter.Range
On Error Resume Next
Set Rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not Rng Is Nothing Then Rng.EntireRow.Copy _
Worksheets("Temp").Range("A" & Sheets("Temp"). _
Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row)
End With
Next I
ActiveSheet.AutoFilterMode = False
End Sub