PDA

View Full Version : Move row if text is in column matches string



ike609
12-30-2011, 03:47 PM
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
12-31-2011, 03:00 PM
Welcome to vbax

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


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

ike609
01-03-2012, 11:41 AM
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
01-03-2012, 12:43 PM
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
01-03-2012, 01:01 PM
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.
img27.imageshack.us/img27/1730/97992350.png

mdmackillop
01-03-2012, 03:13 PM
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

ike609
01-05-2012, 11:14 AM
worked perfect! thanks a ton!!!!! Gary

kamalmalek
01-05-2012, 02:13 PM
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
01-05-2012, 02:28 PM
'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

and
'Identify the blank cells from which the data was cut and delete the entire row of each

Nms.SpecialCells(xlCellTypeBlanks).EntireRow.Delete