I want to trigger a Macro to run only in the row that the cell is triggered. It is an part of an approval process. When the user selects "A" from the drop down list, I want the corresponding number to be copied to another spreadsheet with a form on it. The issue is that it does not need to run for every cell in the column that has "A" in it. Only the one just changed to "A". Is this even possible?

Column with Drop Down List is point of approval for user.

Upon selecting A from the drop down, the corresponding number from Column X needs to be copied to another Worksheet.

CodePudding user response：

Microsoft Docs has the exact documentation found

Sheet Module, e.g. Sheet1

Option Explicit

' This event is triggered by any manual change in the worksheet i.e.
' writing a value to a cell (e.g. Range("N4")), copy-pasting values
' to multiple contiguous cells i.e. a range (e.g. Range("L5:P10")), and doing
' the same by using VBA which additionally can write
' to a non-contiguous range (e.g. Range("A1,N4,C7")).
' All these cells (or only one) that are being written to at the same time
' are referenced by 'Target'.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    ' Source
    Const sFirstCellAddress As String = "N4"
    Const sColumn As String = "X"
    Const sCriteria As String = "A"
    ' Destination
    Const dName As String = "Sheet2"
    Const dColumn As String = "A"
    
    ' Reference the range of interest, the source range.
    Dim srg As Range
    With Me.Range(sFirstCellAddress)
        Set srg = .Resize(Me.Rows.Count - .Row   1)
        ' i.e. 'N4:N1048576', or 'N4:N65536' for prior Office 2007
    End With
    
    ' Use 'Intersect' to reference only the cells of the source range.
    Dim irg As Range: Set irg = Intersect(srg, Target)
    
    ' Check if there are no source range cells contained in 'Target'
    ' and exit if true.
    If irg Is Nothing Then Exit Sub
    
    ' Status: There are cells (at least one) from the source range
    ' contained in 'Target'.
     
    ' Reference the destination worksheet and the last occupied cell
    ' in the destination column ('dColumn').
    Dim dws As Worksheet: Set dws = Me.Parent.Worksheets(dName)
    Dim dCell As Range: Set dCell = dws.Cells(dws.Rows.Count, dColumn).End(xlUp)
     
    Dim iCell As Range
    
    ' Loop through all the cells referenced by 'irg'.
    For Each iCell In irg.Cells
        ' Check if the current intersecting cell is equal to the criteria.
        If StrComp(CStr(iCell.Value), sCriteria, vbTextCompare) = 0 Then
            ' Reference the cell below the last occupied destination cell.
            Set dCell = dCell.Offset(1)
            ' Write the value from the cell in the source column in the same
            ' row as the current intersecting cell ('iCell'),
            ' to the destination cell.
            dCell.Value = iCell.EntireRow.Columns(sColumn).Value
            ' or the equivalent which may be more understandable at this stage:
            'dCell.Value = Me.Cells(iCell.Row, sColumn).Value
        'Else ' is not equal to the criteria; do nothing
        End If
    Next iCell
        
End Sub