VBA help! drop down selected - copy and paste data

[Emily2]

Hi All,

Wondering if anyone can help me, I am trying to create a macro that if the drop down box in column BP of a spreadsheet is selected as "Successful", then that particular row is copied, and pasted to a worksheet in the same workbook named "Successful projects" . basically a summary of all successful projects from a database page. but some may change from submitted to successful at any time.

I would also like to know if there is a way of just copying certain cells of the row, and not the whole row?

Any help would be greatly appreciated.

[vcoolio]

Hello Emily,

The following code may help:-

Sub CopyIt2()
Application.ScreenUpdating = False
   Dim lRow As Long
lRow = Range("A" & Rows.Count).End(xlUp).Row
Sheets("Input").Select
For Each cell In Range("R2:R" & lRow)
      If cell = "Successful" Then
      Range(Cells(cell.Row, "C"), Cells(cell.Row, "L")).Copy
      Sheets("Successful Projects").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      cell.EntireRow.ClearContents
End If
Next
Columns("A").SpecialCells(4).EntireRow.Delete
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Successful Projects").Select
End Sub

Just for the sake of the exercise, the data in the attached test work book, covers Columns A:R with the criteria ("Successful") found in Column R. Just as an example, the code only transfers data from Column C to Column L. You can, of course, select the entire row if you prefer or other cells of your choice.

The code also deletes the entire row of data that is transferred from the Input sheet (even though only certain cells are actually transferred).

There is another code in module 1 in the test work book which uses Autofilter but does the same job as the code above.

I hope that this helps.

Cheerio,
vcoolio.

[Emily2]

Hi vcoolio

Thank you for your response,

It is coming up with an error 'Subscript out of range'?

Ideally i would like - if the drop down option of successful is clicked, then it automatically transfers the row to the successful projects tab, I dont need the row deleted as the database needs to hold all projects if that makes sense?

Many thanks for your help

[vcoolio]

Hello Emily,

That error comes up generally when there is a spelling or punctuation (including spaces) mistake and thus the code cannot find the sheet it needs to interact with.

Check that all spelling etc. is exactly the same in the code, the sheet tab name and in your data set (the criteria). The code is case sensitive.

"Ideally i would like - if the drop down option of successful is clicked, then it automatically transfers the row to the successful projects tab"

The code does exactly that.

If you don't need any rows deleted, then remove this line from the code:-

cell.EntireRow.ClearContents

Cheerio,
vcoolio.

[Aussiebear]

Try the following, but bear in mind that it will copy all values from Column A to Column BP in the target row of the active sheet to the next line on the "Successful Projects" sheet

Private Sub WorkSheet_Change(ByVal As Range)
Dim lRow As Long
lRow = Sheets("Successful Projects").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
With Sheets("Sheet1") 'Change sheet name to active sheet name
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Column = 42 and Target.Row > 1 Then 'Assumes you have headers in Row 1
If Target = "Successful" Then
With ActiveSheet
Range(.Cells(Target.Row, 1), .Cells(Target.Row, 42)).Copy
With Sheets("Successful Projects")
Range(.Cells(lRow, 1), .Cells(lRow, 42) .PasteSpecial xlValues
End With
End With
End if
End If
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

[Emily2]

thanks Vcoolio, it is now transferring if i run the macro each time, it is now saying no cells were found and highlighting Columns("A").SpecialCells(4).EntireRow.Delete?

[Emily2]

also , sorry to be a pain, but each time i click to re run the data, it pastes it all again, so i am then getting duplicated entries, is there a way in which it will just paste the new ones that havent already been transferred?

[vcoolio]

Hello Emily,

Apologies. I should have told you to also remove this line of code besides the other one in post #4:-

    Columns("A").SpecialCells(4).EntireRow.Delete

also , sorry to be a pain, but each time i click to re run the data, it pastes it all again, so i am then getting duplicated entries, is there a way in which it will just paste the new ones that havent already been transferred?

This is happening because we are no longer deleting the "used" rows of data because you need the data base to keep all entries. However, not to worry. Just add the following line to the code:-

Sheets("Successful Projects").Range("A2:R" & lRow).ClearContents

just after this line of code:-

lRow = Range("A" & Rows.Count).End(xlUp).Row

There should no longer be any duplicates in the "Successful Projects" sheet. You will need to change the cell references ("A2:R") in the new line of code to suit yourself ("A2:BP" ?).

I'm just referring to the CopyIT2 macro above in Module 2.
Also, just remember that the code will only transfer the rows of data that have "Successful" placed in Column R.

So the whole adjusted code should look like this:-

Sub CopyIt2()
Application.ScreenUpdating = False
   Dim lRow As Long
lRow = Range("A" & Rows.Count).End(xlUp).Row
Sheets("Successful Projects").Range("A2:R" & lRow).ClearContents
Sheets("Input").Select
For Each cell In Range("R2:R" & lRow)
      If cell = "Successful" Then
      Range(Cells(cell.Row, "C"), Cells(cell.Row, "L")).Copy
      Sheets("Successful Projects").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      End If
  Next
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Successful Projects").Select
End Sub

Again, change all cell references to suit yourself.

I hope that this helps.

Cheerio,
vcoolio.