![]() |
Unlock certain cells based on ColorIndex
I am working on a document that calculates indices based on a set of default
weightings. I want to allow the user to redistribute these weights without changing the default information. It is set up so that the user can make alterations in the cells that have a yellow background. There are many sheets in the workbook and the location of the yellow cells are not uniform. I've written the following code that loops through each worksheet, unlocks the yellow cells, and protects the sheet. The trouble is that it is very buggy and for some reason selects some yellow cells but not others. Occasionally I get an error 1004 message. Is there a more elegant way to do this? For Each wks In ActiveWorkbook.Worksheets str = wks.Name 'Unlock yellow cells For ColIndex = 1 To 40 For RowIndex = 1 To 320 If Cells(RowIndex, ColIndex).Interior.ColorIndex = 36 Then Cells(RowIndex, ColIndex).Locked = False Cells(RowIndex, ColIndex).FormulaHidden = False End If Next RowIndex Next ColIndex 'Protect worksheet wks.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True Next wks |
Unlock certain cells based on ColorIndex
Have a go with this -
Sub UnLockClrIdx36() Dim sPassWord As String Dim rng As Range, cell As Range Dim wb As Workbook Dim ws As Worksheet sPassWord = "" ' "abc" Set wb = ActiveWorkbook For Each ws In wb.Worksheets With ws .Unprotect sPassWord Set rng = .Range(.Cells(1, 1), .Cells(320, 40)) Set rng = Intersect(.UsedRange, rng) End With For Each cell In rng If cell.Interior.ColorIndex = 36 Then With cell .Locked = False .FormulaHidden = False End With End If Next ws.Protect _ Password:=sPassWord, _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True Next End Sub Regards, Peter T "Samantha" wrote in message ... I am working on a document that calculates indices based on a set of default weightings. I want to allow the user to redistribute these weights without changing the default information. It is set up so that the user can make alterations in the cells that have a yellow background. There are many sheets in the workbook and the location of the yellow cells are not uniform. I've written the following code that loops through each worksheet, unlocks the yellow cells, and protects the sheet. The trouble is that it is very buggy and for some reason selects some yellow cells but not others. Occasionally I get an error 1004 message. Is there a more elegant way to do this? For Each wks In ActiveWorkbook.Worksheets str = wks.Name 'Unlock yellow cells For ColIndex = 1 To 40 For RowIndex = 1 To 320 If Cells(RowIndex, ColIndex).Interior.ColorIndex = 36 Then Cells(RowIndex, ColIndex).Locked = False Cells(RowIndex, ColIndex).FormulaHidden = False End If Next RowIndex Next ColIndex 'Protect worksheet wks.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True Next wks |
Unlock certain cells based on ColorIndex
Peter,
This seems to be working okay. Thanks so much! "Peter T" wrote: Have a go with this - Sub UnLockClrIdx36() Dim sPassWord As String Dim rng As Range, cell As Range Dim wb As Workbook Dim ws As Worksheet sPassWord = "" ' "abc" Set wb = ActiveWorkbook For Each ws In wb.Worksheets With ws .Unprotect sPassWord Set rng = .Range(.Cells(1, 1), .Cells(320, 40)) Set rng = Intersect(.UsedRange, rng) End With For Each cell In rng If cell.Interior.ColorIndex = 36 Then With cell .Locked = False .FormulaHidden = False End With End If Next ws.Protect _ Password:=sPassWord, _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True Next End Sub Regards, Peter T "Samantha" wrote in message ... I am working on a document that calculates indices based on a set of default weightings. I want to allow the user to redistribute these weights without changing the default information. It is set up so that the user can make alterations in the cells that have a yellow background. There are many sheets in the workbook and the location of the yellow cells are not uniform. I've written the following code that loops through each worksheet, unlocks the yellow cells, and protects the sheet. The trouble is that it is very buggy and for some reason selects some yellow cells but not others. Occasionally I get an error 1004 message. Is there a more elegant way to do this? For Each wks In ActiveWorkbook.Worksheets str = wks.Name 'Unlock yellow cells For ColIndex = 1 To 40 For RowIndex = 1 To 320 If Cells(RowIndex, ColIndex).Interior.ColorIndex = 36 Then Cells(RowIndex, ColIndex).Locked = False Cells(RowIndex, ColIndex).FormulaHidden = False End If Next RowIndex Next ColIndex 'Protect worksheet wks.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True Next wks |
All times are GMT +1. The time now is 06:30 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com