Macro assistance

[MOB]

This is what I'm trying to acheive;

When someone double clicks on a cell in row 4 (columns J to AM), the worksheet unlocks, copies the contents of the column to the left, pastes it into that column and re-locks the worksheet.

eg - double click on J4, (unlocks) copies contents of column I, pastes it into column J (re-locks)

Is this possible?

Thanks in advance!

 

[Weaver]

Right click the tab of the worksheet you want this to work in and choose 'view code', then paste the following

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("J4:AM4")) Is Nothing Then
        Target.Value = Target.Offset(0, -1).Value
    End If
End Sub

note, this only copies values. If you need to copy formulas, formatting etc, it will need to be modified accordingly.

 

[MOB]

I do need it to be a complete copy of the column, so formulae, formats etc.

 

[Weaver]

Is the sheet password protected?

 

[MOB]

It is yes

 

[Weaver]

try this:

You'll need to type alt+F11, insert a new module, paste this code in then close and reopen the file for it to work. Delete the original code I posted if you ever used it.

Youll also need to change the password to suit.

Hope this helps.

Sub Auto_Open()
    On Error Resume Next
    Application.OnDoubleClick = "updateFromLeft"
 
End Sub
Sub updateFromLeft()
    Dim WasProtected As Boolean
    On Error GoTo myhandler
 
    If ActiveCell.Row = 4 And ActiveCell.Column > 9 And ActiveCell.Column < 40 Then
        If ThisWorkbook.ActiveSheet.ProtectContents = True Then
            ThisWorkbook.ActiveSheet.Unprotect Password:="test"
            WasProtected = True
        Else
            WasProtected = False
        End If
            ActiveCell.Offset(, -1).Copy Destination:=ActiveCell
        If WasProtected Then ThisWorkbook.ActiveSheet.Protect Password:="test"
        Exit Sub
    Else
        Application.SendKeys "{F2}"
        Exit Sub
    End If
 
myhandler:
    If Application.ScreenUpdating <> True Then Application.ScreenUpdating = True
    Application.SendKeys "{F2}"
End Sub

 

[MOB]

Hi

Thanks for that - very nice!

One issue - all it is copying over is the contents of row 4 of the relevant column, not the whole column.

 

[Weaver]

Just got back from lunch.

Quick question, should any of the data above row 4 be copied over? Also, you could copy the whole column whether there's data or not, or copy just the rows with data? Any preference?

If it's the whole column, then this should work (just replace the 1 line - you should be able to tell which one)

ActiveCell.Offset(, -1).EntireColumn.Copy Destination:=ActiveCell.EntireColumn

If there's a lot of data put the following in after the on error command

application.screenupdating = false

 

[MOB]

Option 1 works perfectly!

Thanks for your help on this, much appreciated.