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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.