PDA

View Full Version : VBA help! drop down selected - copy and paste data



Emily2
06-24-2015, 03:09 AM
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
06-24-2015, 04:36 AM
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
06-24-2015, 05:02 AM
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
06-24-2015, 05:59 AM
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
06-24-2015, 06:03 AM
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
06-24-2015, 07:14 AM
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
06-24-2015, 07:19 AM
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
06-24-2015, 03:56 PM
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.