Move row if text is in column matches string

[ike609]

OK i have looked all over and can't seem to find anyone who has had the same issue as i am.

I would like to create a VBA script that will Search Colum A for 4 employee names out of the list of about 20:
Julianne
Ramero
Allie
Louis
This list is dynamic so the row they are in is always changing.

Then select the corresponding row and cut and paste it to say A36:A40. The original row would also need to be deleted while maintaining the gap between employees.
I have attached a copy of it with sheets labeled before and after to show what result i am hoping to get! Thanks in advance! Gary

[mdmackillop]

Welcome to vbax

Assuming the 4 names are in a block below and separated from the full list

[VBA]
Option Explicit

Sub GetData()
Dim c As Range, Nms As Range
Dim emp As Range
Dim e As Range

Set c = Columns(1).Find("Employee name")
Set Nms = Range(c(2), c(2).End(xlDown))
Set emp = c.End(xlDown).End(xlDown)
Set emp = Range(emp, emp.End(xlDown))

For Each e In emp
Nms.Find(e, lookat:=xlWhole).EntireRow.Cut e
Next

Nms.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub
[/VBA]

[ike609]

Thanks for the reply!

I am getting an runtime error '91' and this is the line it highlights when i debug:
Nms.Find(e, lookat:=xlWhole).EntireRow.Cut e

The only adjustments i am making to the code is in red:
Set c = Columns(1).Find("John Doe")

Also can i specify where the row will be copied such as A36?

Thanks again! Gary

[mdmackillop]

Enter the names as shown in rows 32-35 of the After sheet and run the code. You don't state how the names are to be provided, so I've made that assumption.

[ike609]

The names will always be the same 4 people it is just there row that will change. I am just trying to get 1 row moved right now and im still getting same error. I have attached a screenshot of the debug screen. and the code.
[vba]img27.imageshack.us/img27/1730/97992350.png[/vba]

[mdmackillop]

[VBA]Option Explicit

Sub GetData()
Dim c As Range, Nms As Range
Dim emp As Range
Dim Arr, a
Dim r As Long


Arr = Array("Julianne", "Ramero", "Allie", "Louis")

Set c = Columns(1).Find("Employee name")
Set Nms = Range(c(2), c(2).End(xlDown))
r = Cells(Rows.Count, 1).End(xlUp).Row + 4


For Each a In Arr
Nms.Find(a, lookat:=xlWhole).EntireRow.Cut Cells(r, 1)
r = r + 1
Next

Nms.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub[/VBA]

[ike609]

worked perfect! thanks a ton!!!!! Gary

[kamalmalek]

thank v much,
could you please explain meaning of this:
For Each a In Arr
Nms.Find(a, lookat:=xlWhole).EntireRow.Cut Cells(r, 1)
r = r + 1
Next

Nms.SpecialCells(xlCellTypeBlanks).EntireRow.Delete


thanks in advance

[mdmackillop]

[VBA]'Loop through each member of the array
For Each a In Arr
'Find an exact match only
Nms.Find(a, lookat:=xlWhole).EntireRow.Cut Cells(r, 1)
'Increment the row to return the result
r = r + 1
Next
[/VBA]
and
[VBA]'Identify the blank cells from which the data was cut and delete the entire row of each

Nms.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

[/VBA]