Allow to edit specific columns after pasting values form another sheet

justme101

New Member
Joined
Nov 18, 2017
Messages
34
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
 

justme101

New Member
Joined
Nov 18, 2017
Messages
34
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
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,614
Office Version
  1. 365
Platform
  1. Windows
You need to lock the cells you don't want users touching.
 

justme101

New Member
Joined
Nov 18, 2017
Messages
34
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.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,614
Office Version
  1. 365
Platform
  1. Windows
Just lock all the cells & then unlock the columns users can edit
 

justme101

New Member
Joined
Nov 18, 2017
Messages
34
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")
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,614
Office Version
  1. 365
Platform
  1. Windows
That is not what I suggested, I used range not columns
 

Watch MrExcel Video

Forum statistics

Threads
1,129,685
Messages
5,637,809
Members
416,983
Latest member
LessThanAverageUser

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
Top