CODEWITHSUNDEEP
vbaexcelcopy
Cornelis
Cornelis

Reputation: 435

Copy value from same row but other Column (variable offset) Excel VBA

The code below makes sure that only one of the cells in the range("D16:E25") can contain any value, when any value/string is entered in one of the other cell's within this range, the code deletes all the others. (This part works fine, thanks to "Macro Man")

Now I'd like the code to copy(and paste to "B5") a value from a certain cell in Column B, this needs to be the the cell in the same row as the value in the range("D16:E16"). Tried the folowing code you can find below... but it didn't work. Does annyone knows a sollution for this? I'd prefer the workbook (cell "B5") to auto update, so without having to run macro's or press buttons.

If Not Intersect(Target, Range("D16:E25")) Is Nothing Then
    If Target.Cells.Count > 1 Then
        MsgBox "Please edit one cell at a time!"
    Else
        Application.EnableEvents = False

        newVal = Target.Value
        Range("D16:E25").ClearContents
        Target.Value = newVal
        a = ActiveCell

        Application.EnableEvents = True
    End If
End If

If a.Column = 4 Then
    Range("B5") = Range(a).Offset(0, -2).Value
        Else: Range("B5") = Range(a).Offset(0, -3).Value
End If

End Sub

Upvotes: 0

Views: 3917

Answers (2)

Stanley
Stanley

Reputation: 2816

3 Issues here: Firstly if a is set as a Range then the correct way to do it would be 

Set a = ActiveCell

Secondly, if a is set as a Range, the correct way to call it in the second if function would be

If a.Column = 4 Then
    Range("B5") = a.Offset(0, -2).Value
       Else: Range("B5") = a.Offset(0, -3).Value
End If

instead of

If a.Column = 4 Then
    Range("B5") = Range(a).Offset(0, -2).Value
       Else: Range("B5") = Range(a).Offset(0, -3).Value
End If

and thirdly the above if function should be placed between

Set a = ActiveCell

and

Application.EnableEvents = True

then your program will be run as intended when the intersect is true.

Upvotes: 2

user4039065
user4039065

Reputation:

Setting up a as a Range object may be a little overkill since you already have the row by looking at the single cell target.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D16:E25")) Is Nothing Then
        On Error GoTo bm_Safe_Exit
        Application.EnableEvents = False
        If Intersect(Target, Range("D16:E25")).Cells.Count > 1 Then
            Application.Undo
            MsgBox "Please edit one cell at a time!"
        Else
            Dim newVal As Variant

            newVal = Target.Value
            Range("D16:E25").ClearContents
            Target.Value = newVal
            Cells(5, 2) = Cells(Target.Row, 2).Value

        End If
    End If

bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

Upvotes: 2

Related Questions