Worksheet change event for a single column

[Bimmy]

Hi,

Below is a recorded macro that looks for text "Message" in Column D and updates with alphabet "A" in respective cell in Column A. It then looks for vertical line "|" in Column D and moves down 2 cell.

The code -

Sub Macro6()
'
' Macro6 Macro
'

'
    Selection.Find(What:="message", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, -3).Range("A1").Select
    ActiveCell.FormulaR1C1 = "a"
    ActiveCell.Offset(0, 1).Range("A1").Select
    Cells.Find(What:="|", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    ActiveCell.Offset(2, 0).Range("A1").Select
End Sub

I want the code to do above activity every time Column D is pasted with any data. It has got to do with worksheet change event, but don't know how to make the required changes.

Since there will be multiple sheets involved I want the code for "ThisWorkbook".

I have attached an example sheet for reference.

Any assistance will be greatly appreciated.

 

[Marc L]

Hi !

In Worksheet_Change event just check Target.Column …​

 

[Bimmy]

Hi Marc,

I'm new to VBA, so requesting for your help.

It would be helpful if you can provide me with the additional code as stated above.

 

[Marc L]

If Target.Column = 4 Then …​

 

[Bimmy]

Hi Marc,

Thanks for providing above piece of code.

Below is the change that I did and it works.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Target.Column = 4 Then
  Selection.Find(What:="message", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, -3).Range("A1").Select
    ActiveCell.FormulaR1C1 = "a"
    ActiveCell.Offset(0, 1).Range("A1").Select
    Cells.Find(What:="|", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    ActiveCell.Offset(2, 0).Range("A1").Select

    End If

End Sub

Thank you Marc ...

 

[Marc L]

Try this revamped event to avoid a raising error if nothing
is found as you could see in the Find sample of VBA help :​

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
           Dim Rg As Range
    If Target.Column = 4 Then
           Set Rg = Selection.Find("message", ActiveCell, xlFormulas, xlPart, xlByRows, xlNext, False, False)
        If Not Rg Is Nothing Then
               Rg(1, -2).Value = "a"
               Set Rg = Cells.Find("|", Rg(1, -1))
            If Not Rg Is Nothing Then
                   Rg(3).Select
               Set Rg = Nothing
            End If
        End If
    End If
End Sub

Do you like it ? So thanks to click on bottom right Like !
​