VBA Find 1st empty cell and paste data from another cell based on contents

[Drivium]

I have an excel spreadsheet with 2 tabs. One is Opportunities and one is Last Planner.

On the opportunities tab I have a column called Status and a column called Opportunity. Example:

(A1) (B1)
Opportunity | Status
-------------------------------------------------
Compare Life | Moved to last planner

My last planner tab has a column called Project and a column called Opportunity. Example:

(A1) (B1)
Project | Opportunity
-------------------------------------------------
Project #1 |
Project #2 |
Project #3 |

If someone selects "moved to last planner" on the "Opportunities" tab from the "Status" column drop down list, I want the opportunity in that row to copy over to the last planner tab in the first available Project # row. By availble, I mean, a project that was not already assigned to another opportunity.


Hope this makes sense. TIA

 

[Drivium]

Here's some code that kinda works...

Private Sub CommandButton1_Click() 'I don't want this to be a button, I want it to just happen when someone makes a selection in the dropdown field.

If Sheets("Opportunities").Range("F3").Value Like "Moved to last planner" Then 'The drop down fields where "moved to last planner" can be selected range from F3:F25, but not sure how to code to look at that range.
Sheets("Opportunities").Range("B3:B25").Copy 'But I only want it to copy the Opportunity that corresponds with the row where "moved to last planner" was chosen. For example, if F3 was chosen, I want B3 to be copied. Also, in case someone changes the drop down later and changes it back, I need to make sure that this is not re-copied over.
Sheets("Last Planner").Activate
Sheets("Last Planner").Range("A65536").End(xlUp).Offset(1, 0).Select 'This finds the first cell that's empty and selects it
Sheets("Last Planner").Paste
End If
End Sub

 

[rjwebgraphix]

please use the word Code surrounded in brackets [] and end in /Code surrounded in brackets [] when posting code. try to keep comments out of code as much as possible or at least on separate lines. Its so much easier when copying into the editor as well as reading the code.

If I understand the need correctly, this should work...

Dim i As Long
Dim lr As Long

For i = 3 To 25
    Sheets("Opportunities").Activate
    If Sheets("Opportunities").Cells(i, "F").Value Like "Moved to last planner" Then
        Sheets("Opportunities").Cells(i, "B").Copy
        Sheets("Last Planner").Activate
        lr = Sheets("Last Planner").Range("A65536").End(xlUp).Row
        Sheets("LastPlanner").Cells(lr + 1, "A").Paste
    End if
Next i

 

[Drivium]

I added this code to the "Opportunities" sheet in vb editor, but when I change drop down cell to "Moved to last planner" in row F on Last Planner tab, nothing seems to happen. The last "Last Planner" reference in the code needed a space, but changing that didn't help.

I tried adding Private Sub Worksheet_Change(ByVal Target As Range) and it gave me an error when I made the selection this time: "Object or property not supported" and hightlighted this code: Sheets("Last Planner").Cells(lr + 1, "A").Paste. Taking shots in the dark as you can tell.. lol ... I really appreciate your help. It may be something in the way I'm implementing it. I'd like the change to happen automatically when a selection is made instead of having to add a button, etc.

 

[rjwebgraphix]

I was having trouble with the copy and paste also in that fashion. The only way I could work around it was to put the code into a sub and then use "call mysubname", however, I think there's a better way to do what you're looking to do.

If you're looking to do this on a Change event then there might be a better way to do it.

In the Opportunities Sheet's code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim tar As Range
Dim lr As Long

Set tar = Application.Intersect(Range(Target.Address), Range("F3:F25"))
    If Not tar Is Nothing Then
        If Sheets("Opportunities").Cells(Target.row, "F").Value Like "Moved to last planner" Then
            lr = Sheets("Last Planner").Range("A65536").End(xlUp).Row
            Sheets("Last Planner").Cells(lr + 1, "A").Value = Sheets("Opportunities").Cells(Target.Row, "B").Value
        End If
    End If

End Sub

It doesn't actually use .copy and .paste, it just assigns the value directly, but only when that particular cell is changed.

So if F5 was changed to read Move to last planner, it will put B5 in the last row in column A on the Last Planner sheet.

 

[rjwebgraphix]

Improved the code just a little more to cover Case Sensitivity and leading or trailing characters.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim tar As Range
Dim lr As Long

Set tar = Application.Intersect(Range(Target.Address), Range("F3:F25"))
    If Not tar Is Nothing Then
        If UCase(Sheets("Opportunities").Range(Target.Address).Value) Like "*MOVED TO LAST PLANNER*" Then
            lr = Sheets("Last Planner").Range("A65536").End(xlUp).Row
            Sheets("Last Planner").Cells(lr + 1, "A").Value = Sheets("Opportunities").Cells(Target.Row, "B").Value
        End If
    End If

End Sub