根据第三个单元格的值将单元格的值复制到另一个单元格中

Question

I need a VBA script to copy the value of a cell (on another sheet) into a blank cell that is to the right of the original reference cell. The reference cell is a Drop Down with three values (Verbal, Written, Demonstrated). I need VBA because once the value has been entered into the cell i need to add additional comments into the cell as well.

Col G is the reference cell with a drop down. Col I is the destination of the VBA code

The look up range is: Sheets.("DO NOT DELETE") Range("C2:D4")

Any help is greatly appreciated!

Answer 1

Make certain that your activesheet is the one with the dropdown values. You must make a call to run this function.

'  This is meant to be run in a module and must be called
Sub tester()
        Dim lastRow As Long, testString As String, rng2Search As Range


            lastRow = ActiveSheet.Range("G65536").End(xlUp).Row
            For i = 1 To lastRow
                If ActiveSheet.Range("G" & i) = "Verbal" Or _
                    ActiveSheet.Range("G" & i) = "Written" Or _
                    ActiveSheet.Range("G" & i) = "Demonstrated" Then
                    Set rng2Search = Sheets("DO NOT DELETE").Range("C2:C4").Find(ActiveSheet.Range("G" & i), LookIn:=xlValues)
                        If Not rng2Search Is Nothing Then
                            ActiveSheet.Range("I" & i).Value = Sheets("DO NOT DELETE").Range("D" & rng2Search.Row).Value
                        End If
                End If
            Next i
            Set rng2Search = Nothing

        End Sub

You can also alter this to run on your worksheet module whenever a cell in column G is changed. Open up the worksheet module that contains your dropdown values and paste this in there.

'  This will run automatically if in the worksheet module    
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng2Search As Range

        If Mid(Target.Address, 1, 2) = "$G" Then
            Set rng2Search = Sheets("DO NOT DELETE").Range("C2:C4").Find(Target.Value, LookIn:=xlValues)
                    If Not rng2Search Is Nothing Then
                        ActiveSheet.Range("I" & Target.Row).Value = Sheets("DO NOT DELETE").Range("D" & rng2Search.Row).Value
                    End If
        End If

    End Sub