pls try this
Sub locksheet()
Dim DataRng As Range, DataFilledRange As Range
Dim WkSht As Worksheet
Set DataRng = ThisWorkbook.Worksheets("April").Range("C3:F7")
Set WkSht = ThisWorkbook.Worksheets("April")
WkSht.Unprotect
With WkSht.Cells
.Locked = fase
.FormulaHidden = False
End With
For Each cls In DataRng
If cls.Value <> "" Then
If WorksheetFunction.CountA(WkSht.Range(Cells(3, cls.Column), Cells(3 +
DataRng.Rows.Count - 1, cls.Column))) <> DataRng.Rows.Count Then
If DataFilledRange Is Nothing Then
Set DataFilledRange = cls
Else
Set DataFilledRange = Application.Union(DataFilledRange, cls)
End If
End If
End If
Next cls
With DataFilledRange
.Locked = True
.FormulaHidden = True
End With
WkSht.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
On Wed, Jun 22, 2011 at 7:28 PM, Rajesh K R <rajeshkainikk...@gmail.com>wrote:
> Hi Vasant
>
> Thanks for the code, its working well I need a condition in this the
> columns must not be locked in case all the data entry cells filled eg;
> A B C D E F G H I
> S N NAME 1 2 3 4 5 6 7
> 3 3 3 1 0 0 0 0
> 1 RAJESH X X X
> 2 SANU X X
> 3 ANIL X X
>
> Here in column C & D have full data so it have to be locked, but
> column"E" don't have full data so it should remain unlocked till it
> finished the data entry.Row 3 have counting formula & Cell "A3" have
> the max formula. u can compare them for
>
> Range("b2").Select
> ActiveCell.Offset(0, 1).Select
> Application.ScreenUpdating = False
> ActiveSheet.Unprotect Password:="rajesh"
> If ActiveCell.Text <> Range("a2").Text Then
> ActiveCell.Offset(0, 1).Select
> Else
> ActiveCell.EntireColumn.Locked = True
> ActiveSheet.Protect Password:="rajesh"
> End If
> Application.ScreenUpdating = True
>
> The code explain my idea about locking, but I don't to know how to
> make a loop .Pls consider this also & modify the code.
>
> Regards
> Rajesh Kainikkara
>
>
> On 6/22/11, Vasant <vasant...@gmail.com> wrote:
> > pls try this
> >
> > this will lock the populated cells in the range C3:AA5 in sheet 'april'
> >
> > Sub locksheet()
> > Dim DataRng As Range, DataFilledRange As Range
> > Dim WkSht As Worksheet
> > Set DataRng = ThisWorkbook.Worksheets("April").Range("C3:AA5")
> > Set WkSht = ThisWorkbook.Worksheets("April")
> > WkSht.Unprotect
> > For Each cls In DataRng
> > If cls.Value <> "" Then
> > If DataFilledRange Is Nothing Then
> > Set DataFilledRange = cls
> > Else
> > Set DataFilledRange = Application.Union(DataFilledRange, cls)
> > End If
> > End If
> > Next cls
> > With DataFilledRange
> > .Locked = True
> > .FormulaHidden = True
> > End With
> > WkSht.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
> > End Sub
> >
> > On Wed, Jun 22, 2011 at 3:54 PM, Rajesh K R
> > <rajeshkainikk...@gmail.com>wrote:
> >
> >> Hi Experts
> >>
> >> I add a code in the work sheet for the identification of data
> >> selected, But the copy paste is not working in that sheet. How can I
> >> solve the issue,Pls check the code & tell me the change required.
> >>
> >> Private Sub Worksheet_SelectionChange(ByVal Target As Range)
> >> Application.EnableEvents = False
> >> Columns(2).Interior.ColorIndex = 15
> >> Cells(ActiveCell.Row, 2).Interior.Color = vbYellow
> >> Application.EnableEvents = True
> >> End Sub
> >>
> >> Regards
> >> Rajesh Kainikkara
> >>
> >> --
> >>
> >>
> ----------------------------------------------------------------------------------
> >> Some important links for excel users:
> >> 1. Follow us on TWITTER for tips tricks and links :
> >> http://twitter.com/exceldailytip
> >> 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
> >> 3. Excel tutorials at http://www.excel-macros.blogspot.com
> >> 4. Learn VBA Macros at http://www.quickvba.blogspot.com
> >> 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
> >>
> >> To post to this group, send email to excel-macros@googlegroups.com
> >>
> >> <><><><><><><><><><><><><><><><><><><><><><>
> >> Like our page on facebook , Just follow below link
> >> http://www.facebook.com/discussexcel
> >>
> >
> >
> >
> > --
> > Regards
> >
> > Vasant
> >
> > --
> >
> ----------------------------------------------------------------------------------
> > Some important links for excel users:
> > 1. Follow us on TWITTER for tips tricks and links :
> > http://twitter.com/exceldailytip
> > 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
> > 3. Excel tutorials at http://www.excel-macros.blogspot.com
> > 4. Learn VBA Macros at http://www.quickvba.blogspot.com
> > 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
> >
> > To post to this group, send email to excel-macros@googlegroups.com
> >
> > <><><><><><><><><><><><><><><><><><><><><><>
> > Like our page on facebook , Just follow below link
> > http://www.facebook.com/discussexcel
> >
>
> --
>
> ----------------------------------------------------------------------------------
> Some important links for excel users:
> 1. Follow us on TWITTER for tips tricks and links :
> http://twitter.com/exceldailytip
> 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
> 3. Excel tutorials at http://www.excel-macros.blogspot.com
> 4. Learn VBA Macros at http://www.quickvba.blogspot.com
> 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
>
> To post to this group, send email to excel-macros@googlegroups.com
>
> <><><><><><><><><><><><><><><><><><><><><><>
> Like our page on facebook , Just follow below link
> http://www.facebook.com/discussexcel
>
--
Regards
Vasant
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel
