Copy/Paste Cell Value Based On Another Cell's Value

[cedwards94]

I am looking to copy and paste a cell's value from one sheet (Cover_Active) to another sheet (Table) if a specific cell's value says "Delayed". To be more precise, if any cells between J16:J25 say "Delayed", the data in the corresponding cell in Column A (A16:A25) would be copied from "Cover_Active" and placed into a table in "Table", specifically in Column A, beginning at cell A2. I am looking to have each instance of this create a new row where there is no data currently (i.e. if A2 has data in it, the macro would paste the information to A3 instead, etc.). For another project, I used the below "Command Button", which copied a specific cell's value and pasted it to another sheet, in a new row, whenever the button was clicked. Essentially, this is what I need to be able to do now, without the use of a Command Button and based on the cell's value.

Private Sub CommandButton10_Click()
Dim IngLstRow&
Dim strMyIPBMsg$
strMyIPBMsg = InputBox("Add Corrective Action:")
With Sheets("SUPV_Passdown_Logged_Solutions")
IngLstRow = .UsedRange.Rows.Count + .UsedRange.Row
.Range("B" & IngLstRow).Value = strMyIPBMsg
End With
Sheets("SUPV_Passdown_Active").Select
Dim ws, ws1 As Worksheet
Set ws = Sheets("SUPV_Passdown_Active")
Set ws1 = Sheets("SUPV_Passdown_Logged_Solutions")
ws.Range("B20").Copy
ws1.Range("A" & IngLstRow).PasteSpecial Paste:=xlPasteAll, Transpose:=True
Application.CutCopyMode = False
ws1.Activate
End Sub

I am still fairly new to using VBA and have searched the Forum here, but have not found what I'm looking for yet. I'm hoping that someone might be able to help me out.

 

[My Aswer Is This]

Assuming you want the script to automatically run any time you enter "Delayed"
Into any cell in sheet named Cover_Active Range("J16:J25")

And copy the value in column A of that same row into A sheet named "Table"

Try this:

This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

When you enter "Delayed" manually into the cell your script will run. This script will not run do to a formula causing "Delayed" to be entered.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("J16:J25")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    If Target.Value = "Delayed" Then
        Dim Lastrow As Long
        Lastrow = Sheets("Table").Cells(Rows.Count, "A").End(xlUp).Row + 1
        Target.Offset(, -9).Copy Sheets("Table").Cells(Lastrow, 1)
    End If
End If
End Sub