+ Reply to Thread
Results 1 to 2 of 2

Automaticaly lock cell based on content of another cell

  1. 12-14-2016, 08:21 PM #1
    Hippolyte
    Hippolyte is offline
    Registered User
    Join Date
    12-14-2016
    Location
    Paris, France
    MS-Off Ver
    2010
    Posts
    3

    Automaticaly lock cell based on content of another cell

    Hello,

    I would like to know if there is a way to lock a cell based on the content of another cell on the same ligne ? (this action will occur multiple times in the sheet)

    So far I have this but it doesn't seem to work and looks quite heavy ...

    I would be very grateful if somebody could help me out on this :

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(ActiveSheet.Cells(32, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(32, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(32, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(32, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(33, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(32, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(33, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(33, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(34, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(32, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(34, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(34, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(35, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(35, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(35, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(35, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(36, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(32, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(36, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(36, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(37, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(37, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(37, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(37, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(38, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(38, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(38, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(38, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(39, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(39, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(39, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(39, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(40, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(40, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(40, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(40, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(41, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(41, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(41, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(41, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(42, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(42, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(42, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(42, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(43, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(43, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(43, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(43, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(44, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(44, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(44, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(44, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(45, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(45, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(45, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(45, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(46, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(46, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(46, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(46, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(47, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(47, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(47, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(47, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(48, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(48, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(48, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(48, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(49, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(49, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(49, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(49, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(50, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(50, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(50, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(50, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(51, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(51, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(51, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(51, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(52, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(52, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(52, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(52, 10)).Locked = False
    End If
    If Intersect(ActiveSheet.Cells(53, 9), Target) Is Not Nothing Then
    If ActiveSheet.Cells(53, 9).Text = "k€" Then
    ActiveSheet.Range(Cells(53, 10)).Locked = True
    Else
    ActiveSheet.Range(Cells(53, 10)).Locked = False
    End If
    End If
    End Sub
    Reply With QuoteRegister To Reply
  2. 12-15-2016, 03:01 PM #2
    mehmetcik
    mehmetcik is offline
    Forum Expert
    Join Date
    12-14-2012
    Location
    London England
    MS-Off Ver
    MS 365 Office Suite.
    Posts
    8,448

    Re: Automaticaly lock cell based on content of another cell

    Wow that looks like hard work.

    I would approach that somewhat differrently.

    1 Create three Strings to Store

    a: locked cell
    b: linked cell
    c: Lock Value

    2 I would convert each string into an array

    3 I would use a sheet specific selection_change macro to look at the cell that you clicked on.

    If the selected cell is in array 1 and its linked cell is its target value then select another cell.

    the coding is simple to create and simple to maintain.

    My code is easily modified to lock the cell if you prefer that.


    Please Login or Register  to view this content.
    Last edited by mehmetcik; 12-15-2016 at 03:17 PM.
    My General Rules if you want my help. Not aimed at any person in particular:

    1. Please Make Requests not demands, none of us get paid here.

    2. Check back on your post regularly. I will not return to a post after 4 days.
    If it is not important to you then it definitely is not important to me.
    Reply With QuoteRegister To Reply
+ Reply to Thread
« Previous Thread | Next Thread »

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Automaticaly lock cell based on content of another cell
    By Hippolyte in forum Hello..Introduce yourself
    Replies: 1
    Last Post: 12-14-2016, 05:11 PM
  2. How to lock a cell content
    By Shadmani in forum Excel General
    Replies: 1
    Last Post: 11-14-2014, 01:13 AM
  3. Lock/unlock specific cells in a row based on another cell content of the same row
    By st_rod000 in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 04-10-2014, 02:58 AM
  4. copying cell content into a specific workbook based on the content in that cell
    By krishna reddy in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 07-20-2012, 03:52 AM
  5. Automaticaly color a cell based on the value of another cell
    By Hatricke in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 03-01-2010, 08:55 PM
  6. Lock and clear cell content based on another cell's value
    By mohitmahajanin in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 10-23-2008, 06:30 AM
  7. How do I lock a cell based on content of another cell?
    By Alan T in forum Excel General
    Replies: 3
    Last Post: 10-23-2006, 08:57 AM

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Forum Rules


Search Engine Friendly URLs by vBSEO 3.6.0 RC 1