VBA code for multiple columns

[WobblyPenguin]

The function is to put an 'X' on the row within that column when the keyword matches what is in column A. I have this working for column 'E' but I would like to apply it to columns F-K as well with the same function.

Any suggestions are appreciated! Thank you in advance!

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCell As Range
    Dim LookupRange As Range
    Dim MatchCell As Range

    ' Define the key cell (E39) and the lookup range (column A)
    Set KeyCell = Me.Range("E39")
    Set LookupRange = Me.Range("A1:A" & Me.Cells(Me.Rows.Count, "A").End(xlUp).Row)

    ' Check if E39 is the changed cell
    If Not Intersect(Target, KeyCell) Is Nothing Then
        Application.EnableEvents = False

        ' Only proceed if E39 has a value
        If KeyCell.Value <> "" Then
            For Each MatchCell In LookupRange
                If MatchCell.Value = KeyCell.Value Then
                    MatchCell.Offset(0, 4).Value = "X" ' Offset to column E
                End If
            Next MatchCell
        End If

        ' Do nothing if E39 is cleared; keep the existing "X" values
        Application.EnableEvents = True
    End If
End Sub

 

[MikeVol]

Hi @WobblyPenguin.
Try next updated code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MatchCell   As Range

    ' Define the key cell (E39) and the lookup range (column A)
    Dim KeyCell     As Range
    Set KeyCell = Me.Range("E39")

    Dim LookupRange As Range
    Set LookupRange = Me.Range("A1:A" & Me.Cells(Me.Rows.Count, "A").End(xlUp).Row)

    ' Check if E39 is the changed cell
    If Not Intersect(Target, KeyCell) Is Nothing Then
        MsgBox "YES, Intersect! "
        Application.EnableEvents = False

        ' Only proceed if E39 has a value
        If KeyCell.Value <> "" Then
            For Each MatchCell In LookupRange

                If MatchCell.Value = KeyCell.Value Then
                    Dim i As Long
                    
                    For i = 4 To 10
                        MatchCell.Offset(0, i).Value = "X"
                    Next i
                
                End If

            Next MatchCell

        End If

        ' Do nothing if E39 is cleared; keep the existing "X" values
        Application.EnableEvents = True
    End If

End Sub

 

[WobblyPenguin]

Hi @WobblyPenguin.
Try next updated code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MatchCell   As Range

    ' Define the key cell (E39) and the lookup range (column A)
    Dim KeyCell     As Range
    Set KeyCell = Me.Range("E39")

    Dim LookupRange As Range
    Set LookupRange = Me.Range("A1:A" & Me.Cells(Me.Rows.Count, "A").End(xlUp).Row)

    ' Check if E39 is the changed cell
    If Not Intersect(Target, KeyCell) Is Nothing Then
        MsgBox "YES, Intersect! "
        Application.EnableEvents = False

        ' Only proceed if E39 has a value
        If KeyCell.Value <> "" Then
            For Each MatchCell In LookupRange

                If MatchCell.Value = KeyCell.Value Then
                    Dim i As Long
                   
                    For i = 4 To 10
                        MatchCell.Offset(0, i).Value = "X"
                    Next i
               
                End If

            Next MatchCell

        End If

        ' Do nothing if E39 is cleared; keep the existing "X" values
        Application.EnableEvents = True
    End If

End Sub

Thank you very much for this @MikeVol . This is working but I should have been more specific when I asked for help. I am looking for each column to have their own input. For example, E39 marks the E column, F39 marks the F column, G39 marks the G column, etc. Any help with this would be helpful. Thank you again for the code you provided me.

 

[MikeVol]

If I understood you correctly, try next

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCell     As Range
    Dim MatchCell   As Range

    Dim LookupRange As Range
    Set LookupRange = Me.Range("A1:A" & Me.Cells(Me.Rows.Count, "A").End(xlUp).Row)

    Application.EnableEvents = False
    On Error GoTo Ext

    For Each KeyCell In Target

        If Not Intersect(KeyCell, Me.Range("E39:K39")) Is Nothing Then

            Dim ColumnOffset As Long
            ColumnOffset = KeyCell.Column - Me.Range("E39").Column + 4

            If KeyCell.Value <> "" Then

                For Each MatchCell In LookupRange

                    If MatchCell.Value = KeyCell.Value Then
                        MatchCell.Offset(0, ColumnOffset).Value = "X"
                    End If

                Next MatchCell

            End If

        End If

    Next KeyCell

Ext:
    Application.EnableEvents = True
End Sub