469,320 Members | 2,192 Online
Bytes | Developer Community
New Post

Home Posts Topics Members FAQ

Post your question to a community of 469,320 developers. It's quick & easy.

excel...Copy row based on word in cell

Hello and goodMorning,

Can anyone please help me with this. I have a database in excel that has 2 sheets full of data. I would like if i press a button to update then macro searches in Column O if the words " Req. Feed Set Up" then it get move over to sheet 2 in the workbook.

Sub Feed_set_up()

Dim intLastRow As Long
intLastRow = ActiveSheet.UsedRange.Rows.Count

'Let's start at row 2. Row 1 has headers
X = 4

'Start the loop
Do While X <= intLastRow
'Look for data with 'Feed set up'
If Cells(X, 15) = "Req. Feed Set Up" Then
'copy the row if it contains '
Worksheets("Sheet1").Rows(X).Copy
'Go to sheet2. Activate it. We want the data here
Worksheets("Sheet2").Activate
'Find the first empty row in sheet2
erow = Sheet2.Cells(Rows.Count, 15).End(xlUp).Offset(1, 0).Row
'Paste the data here
ActiveSheet.Paste Destination:=Worksheets("Sheet2").Rows(erow)
End If
'go to sheet1 again and actvate it
Worksheets("Sheet1").Activate
'Loop through the other rows with data
X = X + 1

Loop
End Sub

I have this code(above)which works great but Everytime i press the update button it copy and paste the rows with the words in Column O overwrites what is in sheet 2. In other words i doesnt not find the fist blank row to paste the data it always starts at row 2 can i get some help with changing this around....
Thanks
Dec 8 '11 #1
7 2742
Guido Geurs
767 Expert 512MB
Sandy,
You want to filter the rows with the text "Req. Feed Set Up" in col "O" (15) and transfer these records (rows) to sheet 2 ?

If so, this is the code:
Expand|Select|Wrap|Line Numbers
  1. Sub Feed_set_up()
  2. Dim LASTROW As Long
  3. Dim ROWidx As Integer
  4.     LASTROW = Range("A2").End(xlDown).Row
  5.     ' Start the loop
  6.     For ROWidx = 2 To LASTROW
  7.         ' Look for data with "Req. Feed Set Up"
  8.         Range("O" & ROWidx).Activate
  9.         If Range("O" & ROWidx).Value = "Req. Feed Set Up" Then
  10.             ' copy the row if it contains
  11.             Range("A" & ROWidx).Resize(, Range("A" & ROWidx).End(xlToRight).Column).Copy
  12.             Worksheets("Sheet2").Activate
  13.             If Range("A1") = "" Then
  14.                 Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
  15.                         False, Transpose:=False
  16.             ElseIf Range("A2") = "" Then
  17.                 Range("A2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
  18.                         False, Transpose:=False
  19.             Else
  20.                 Range("A" & Range("A1").End(xlDown).Row + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
  21.                         False, Transpose:=False
  22.             End If
  23.         End If
  24.         ' go to sheet1 again and actvate it
  25.         Worksheets("Sheet1").Activate
  26.     Next
  27. End Sub
PS: if it's to slow (to manny rows) use array's:
- Set sheet1 in an array and put the results in an other array.
- Dump the array with results in sheet2.
Attached Files
File Type: zip excel...copy row based on word in cell_v1.zip (10.1 KB, 59 views)
Dec 9 '11 #2
Thank Guido,
Thanks for the help on this Macro, This is what i was looking for but I would like to cut the Entire Row and paste it into sheet 2.

Expand|Select|Wrap|Line Numbers
  1. Option Explicit
  2. Sub MoveYesToCompleted()
  3.     Dim ShPendingNextRow As Long
  4.     Dim ShPendingLastRow As Long
  5.     Dim ShCompletedBlankRow As Long
  6.  
  7.     ShPendingLastRow = Worksheets("Pending").Cells(Rows.Count, "A").End(xlUp).Row
  8.  
  9.     For ShPendingNextRow = ShPendingLastRow To 6 Step -1
  10.         If Worksheets("Pending").Cells(ShPendingNextRow, "G").Value = "Req. Feed Set Up" Then
  11.             ShCompletedBlankRow = Worksheets("Completed").Cells(Rows.Count, "A").End(xlUp).Row + 1
  12.             With Worksheets("Pending")
  13.                 .Rows(ShPendingNextRow).Cut Destination:=Worksheets("Completed").Range("A" & ShCompletedBlankRow)
  14.                 .Rows(ShPendingNextRow).EntireRow.Delete
  15.             End With
  16.         End If
  17.     Next
  18. End Sub
I found this code on another fourm and it works great on a dummy file but then when i try to move it over to my real file it does not work.
I think its because the other file is to large I might need to change it into array and filter then dump results into sheet2 (just like you said) and i would like if this is possible to search on 2 sheet in my really file called sheet1 and sheet2 the dump results in in "Active" worksheet. Thanks Guido!!!! your the best...
Dec 9 '11 #3
Hey Guido,
I got it to work on my real file but for some reason it dosent grab all of them??? i dont know why
Dec 9 '11 #4
Guido Geurs
767 Expert 512MB
Attached is a standard tool to search rows.
Attached Files
File Type: zip EXCEL...copy row based on word in cell_1.11.zip (208.0 KB, 90 views)
Dec 14 '11 #5
Wow Guido thanks for this it looks like so much I’m a little intimidated to use this. How do I transfer the tool into the worksheet that I going to use this in. what I do is that is just copy and paste everything into the correct workbook, I just would like to know if there is an easier way to do it.
Thanks for your help...
Dec 16 '11 #6
Guido Geurs
767 Expert 512MB
No need to copy each time the code to the workbooks!
Just open the tool workbook with the form and open also the workbook in which you want to use the form.
Run in the second workbook the macro from the tool workbook with =
Start the User Form with the macro=
'UF Copy Rows.xls'!Start_Copy_Rows.
Dec 16 '11 #7
Ohh okay thanks. I guess i was doing it the really long and dum way thanks guido...
Dec 16 '11 #8

Post your reply

Sign in to post your reply or Sign up for a free account.

Similar topics

1 post views Thread by CARIGAR | last post: by
reply views Thread by Gurmeet2796 | last post: by
reply views Thread by mdpf | last post: by
reply views Thread by listenups61195 | last post: by
By using this site, you agree to our Privacy Policy and Terms of Use.