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
 
As you have already unlocked all the cells, you will need to relock those that shouldn't be touched.

The code to protect the sheet again is already at the end. I forgot to paste it here. It locks the sheet, but not the ranges.

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
   
ActiveWorkbook.Worksheets("Status Update").Protect "12345"

End Sub
 
Upvote 0

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
You need to lock the cells you don't want users touching.
 
Upvote 0
You need to lock the cells you don't want users touching.

How do you suggest I do that? Because, the number of lines coming into the Status Tracker sheet will be random, depending on the filter criteria. Sometimes 3 or 4 or may be even 10 lines. That is why I wanted just to unlock certain columns, which need to be edited.
 
Upvote 0
Just lock all the cells & then unlock the columns users can edit
 
Upvote 0
Just lock all the cells & then unlock the columns users can edit

OK. So, somehow I managed to get it working and the working code is given below:

VBA Code:
Sub wip_data()

ActiveWorkbook.Worksheets("Status Update").Unprotect "12345"
ActiveWorkbook.Worksheets("Status Update").Range("A:U").Locked = True

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

Selection.Locked = True
    Selection.FormulaHidden = False
    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

Worksheets("Status Update").Cells.Select

        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
       
ActiveWorkbook.Worksheets("Status Update").Protect "12345"
  
End Sub

But, when I implement your earlier suggestion (for making column D, L & M as editable), it gives me "Run Time Error 13: Type Mismatch"

VBA Code:
 .Add Title:="Range1", Range:=Columns("D:D,L:M")
 
Upvote 0
That is not what I suggested, I used range not columns
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,144
Members
448,552
Latest member
WORKINGWITHNOLEADER

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