Allow to edit specific columns after pasting values form another sheet

justme101

Board Regular
Joined
Nov 18, 2017
Messages
67
Office Version
  1. 365
Platform
  1. Windows
Hello All,

I am copying cells from a sheet titled "Data" to another sheet called "Status Update". The user will have the flexibility to edit only ranges in two columns, L & M, and others will be locked. I have the code to copy the cells and paste it but the allow edit ranges part gives the run time 1004: Application defined or object-defined error. The code i use is given below. Any help is appreciated.

ActiveWorkbook.Worksheets("Status Update").Unprotect "12345"
ActiveSheet.Cells.Locked = False

Set sh = Sheets("Data")

sh.Range("M1:M" & sh.Cells(sh.Rows.Count, 1).End(xlUp).Row).AutoFilter 1, "WIP"
With Worksheets("Data").AutoFilter.Range
Range("A" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Select
End With
sh.Range("A2:A" & sh.Cells(sh.Rows.Count, 1).End(xlUp).Row).EntireRow.SpecialCells(xlCellTypeVisible).Copy

ActiveWorkbook.Worksheets("WIP Tracker").Range("A3").PasteSpecial xlPasteValues
ActiveWorkbook.Worksheets("WIP Tracker").Range("A3").PasteSpecial xlPasteFormats

Application.CutCopyMode = False

Sheets("Status Update").Columns("L:M").Select
Sheets("Status Update").Protection.AllowEditRanges.Add Title:="Range1", Range:=Columns( _
"L:M")

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
If you only have the one edit range on that sheet try
VBA Code:
Sheets("Status Update").Select
With Sheets("Status Update").Protection.AllowEditRanges
   If .Count > 0 Then
      .Item("Range1").Delete
   End If
   .Add Title:="Range1", Range:=Columns("L:M")
End With
 
Upvote 0
If you only have the one edit range on that sheet try
VBA Code:
Sheets("Status Update").Select
With Sheets("Status Update").Protection.AllowEditRanges
   If .Count > 0 Then
      .Item("Range1").Delete
   End If
   .Add Title:="Range1", Range:=Columns("L:M")
End With
Thank Fluff! This works. Just to add to my query. How to add columns to this code, if they are not next to each other. For e.g. if the ranges I want to be edited are Columns D, L & M?
 
Upvote 0
How about
VBA Code:
   .Add Title:="Range1", Range:=Range("D:D,L:M")
 
Upvote 0
OK, I don't
How about
VBA Code:
   .Add Title:="Range1", Range:=Range("D:D,L:M")
OK, I don't know what is going on, but your original reply worked the first time I tested it, but it is not working now. I have not even added your next suggestion for column D. Is it something to do with range names? I don't know what to do. The current code is this:

VBA Code:
ActiveWorkbook.Worksheets("Status Update").Unprotect "12345"
ActiveSheet.Cells.Locked = False

Set sh = Sheets("Data")

sh.Range("M1:M" & sh.Cells(sh.Rows.Count, 1).End(xlUp).Row).AutoFilter 1, "WIP"
With Worksheets("Data").AutoFilter.Range
Range("A" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Select
End With
sh.Range("A2:A" & sh.Cells(sh.Rows.Count, 1).End(xlUp).Row).EntireRow.SpecialCells(xlCellTypeVisible).Copy

ActiveWorkbook.Worksheets("Status Update").Range("A3").PasteSpecial xlPasteValues
ActiveWorkbook.Worksheets("Status Update").Range("A3").PasteSpecial xlPasteFormats

Application.CutCopyMode = False

Sheets("Status Update").Select
With Sheets("Status Update").Protection.AllowEditRanges
   If .Count > 0 Then
      .Item("Range1").Delete
   End If
   .Add Title:="Range1", Range:=Columns("L:M")
End With

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
   
End Sub
 
Upvote 0
What is the error number & message & what line is highlighted?
 
Upvote 0
N
What is the error number & message & what line is highlighted?
No error, it just copy pastes the cells according to the filter, but does not lock anything. I am able to edit every cell in the pasted data.
 
Upvote 0
That's because you are unlocking all the cells with this line (assuming the staus update sheet is active)
VBA Code:
ActiveSheet.Cells.Locked = False
 
Upvote 0
That's because you are unlocking all the cells with this line (assuming the staus update sheet is active)
VBA Code:
ActiveSheet.Cells.Locked = False
Removed it. Still the same.
 
Upvote 0
As you have already unlocked all the cells, you will need to relock those that shouldn't be touched.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,202
Members
448,554
Latest member
Gleisner2

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