Use Excel VBA to update column cell contents

Question

This is a simple answer but one I cannot find.

I have two columns of data.

Column A (1) has yes/no data validation list options in every cell.

Column B also has data validation with say 6 strings of text options in every cell.

But I only want each the corresponding cell (column B) to update in the same row as column A

eg A20 toggled, then B20 is updated. Like so

A20 is selected “Yes” from the dropdown option and B20 is updated with the string “complete” which is one of the states you can select in the dropdown boxes manually in every cell in column B.

I had some code but I would have to write an argument for every cell and then two macros for every yes / no.

This is code that works for one cell only but this is not ideal for many cells but it works

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A20")) Is Nothing Then
        Select Case Range("A20")
            Case "Yes": Macro_001
            Case "No": Macro_002
        End Select
    End If
    End Sub

Sub Macro_001()
    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    Sheets("August 2020").Select
    Sheets("August 2020").Range("B20").Select
    ActiveCell.FormulaR1C1 = "Complete"
    Application.ScreenUpdating = True
   Application.Calculation = xlAutomatic
End Sub

Sub Macro_002()
    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    Sheets("August 2020").Select
    Sheets("August 2020").Range("B20").Select
    ActiveCell.FormulaR1C1 = ""
   Application.ScreenUpdating = True
   Application.Calculation = xlAutomatic
End Sub

There much be an easier way with.range perhaps

Thanks in advance

Answer 1

In the developer tab click view code, choose the sheet you want the macro to run on, make sure the upper left drop down says worksheet and the upper right says Change (I'll assume your sheet has headers):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim ChangeCell As Range
Dim numrows As Long

numrows = Cells(Rows.Count, 1).End(xlUp).Row

Set TriggerCells = Range("A1")
Set KeyCells = Range("B2:B" & numrows)

If Application.Intersect(TriggerCells, Range("A1")) = "[Column Header Text]" Then
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
        If Target.Value = "Yes" Then
            Range("B" & Target.Row).Value = "Completed"
        End If
    End If
End If
End Sub

Try that, see if it works for you.