Copy Selected Cell with range and offset paste its value

Cat129

Board Regular
Joined
Oct 20, 2012
Messages
96
Hey guys

I pinched this code from another post, and tweaked it to my needs, but I now need to develop it further.

All it does is when the data is changed in column R, it inputs the date it was edited and the username that made the change to the next columns along.

What I now would like to do, it take the value that was in that range originally, copy it is a value to an adjacent column. Is this possible?

So if a user updated the Value in N1 from 31 to 67, I would like 31 to show in M1 and 67 to show in N1, Date in O1, Username in P1

Any help is greately appreciated. Thank You

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
    Set WorkRng = Intersect(Application.ActiveSheet.Range("n:n"), Target)
    xOffsetColumn = 1
        If Not WorkRng Is Nothing Then
            Application.EnableEvents = False
            For Each Rng In WorkRng
                If Not VBA.IsEmpty(Rng.Value) Then
                    'Rng.Offset(0,1).Value=
                    Rng.Offset(0, xOffsetColumn).Value = Now
                    Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy"
                    Rng.Offset(0, 2).Value = Environ("USERNAME")
                    
                Else
                    Rng.Offset(0, xOffsetColumn).ClearContents
                End If
        Next
        Application.EnableEvents = True
    
        End If
End Sub
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Have a try, I just added a macro with event Worksheet_SelectionChange (and a new variable) to store the old data from column "N".
VBA Code:
Option Explicit
Public OldData                                    '<- added
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WorkRng As Range
    Dim Rng    As Range
    Dim xOffsetColumn As Integer
    Set WorkRng = Intersect(Application.ActiveSheet.Range("N:N"), Target)
    xOffsetColumn = 1
    If Not WorkRng Is Nothing Then
        Application.EnableEvents = False
        For Each Rng In WorkRng
            If Not VBA.IsEmpty(Rng.Value) Then
                Rng.Offset(0, -1).Value = OldData '<- added
                Rng.Offset(0, xOffsetColumn).Value = Now
                Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy"
                Rng.Offset(0, 2).Value = Environ("USERNAME")
            Else
                Rng.Offset(0, xOffsetColumn).ClearContents
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub
'--- added ----------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("N:N")) Is Nothing Then Exit Sub
    OldData = Target.Value
End Sub
'So if a user updated the Value in N1 from 31 to 67,
'I would like 31 to show in M1 and 67 to show in N1,
'Date in O1, Username in P1
 
Upvote 0
Solution
The code you have posted would not do as you say for column R as it is looking at column N.
Your request fro column N is possible but is that in stead of it focusing on R and adding the details you describe or instead of
 
Upvote 0
The code you have posted would not do as you say for column R as it is looking at column N.
Your request fro column N is possible but is that in stead of it focusing on R and adding the details you describe or instead of
N is the current mass of an object, so when a user edits N, I would like it to copy what was in N before they changed it to M, and then update N to their new input.

I don't think this is possible, but wanted to ask anyway. I could get around this by forcing the user to use a userform (quite a few things would need to update in this way)
 
Upvote 0
have you tried the option suggested by rollis13 in post#2. Looks like it should do what you need.
If not there is another option via undo and storing the old value as a variable and copying to M
 
Upvote 0
Have a try, I just added a macro with event Worksheet_SelectionChange (and a new variable) to store the old data from column "N".
VBA Code:
Option Explicit
Public OldData                                    '<- added
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WorkRng As Range
    Dim Rng    As Range
    Dim xOffsetColumn As Integer
    Set WorkRng = Intersect(Application.ActiveSheet.Range("N:N"), Target)
    xOffsetColumn = 1
    If Not WorkRng Is Nothing Then
        Application.EnableEvents = False
        For Each Rng In WorkRng
            If Not VBA.IsEmpty(Rng.Value) Then
                Rng.Offset(0, -1).Value = OldData '<- added
                Rng.Offset(0, xOffsetColumn).Value = Now
                Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy"
                Rng.Offset(0, 2).Value = Environ("USERNAME")
            Else
                Rng.Offset(0, xOffsetColumn).ClearContents
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub
'--- added ----------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("N:N")) Is Nothing Then Exit Sub
    OldData = Target.Value
End Sub
'So if a user updated the Value in N1 from 31 to 67,
'I would like 31 to show in M1 and 67 to show in N1,
'Date in O1, Username in P1
You Genius! Yes sorry it was a typo because I moved the columns around and wasn't thinking. This works perfectly and I can just adjust the code to move the data where needed.

Thank You!
 
Upvote 0
have you tried the option suggested by rollis13 in post#2. Looks like it should do what you need.
If not there is another option via undo and storing the old value as a variable and copying to M
Thanks, I was just trying out the code and editing it before I read it properly. Yes rollis13 code does what I need and I can just edit the offsets as needed. Thank for you help
 
Upvote 0
Thanks for the positive feedback, glad we were able to help(y).
 
Upvote 0

Forum statistics

Threads
1,214,619
Messages
6,120,550
Members
448,970
Latest member
kennimack

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top