Results 1 to 6 of 6
  1. #1
    New Lounger
    Join Date
    Apr 2016
    Posts
    2
    Thanks
    3
    Thanked 0 Times in 0 Posts

    Question Conditional locked cells

    In my spreadsheet, users can either

    #1. enter a value in cell H9 which locks cells I9:S9 (ideally also changes the colour of those cells to e.g. grey)
    OR
    #2. entry in ANY cells in the range I9:S9 locks cell H9 from entry (ideally also changes the colour of that cell to e.g. grey)


    Also, if users chose to enter values in I9:S9 then they must enter a value in EACH of the cells in that range

    There cannot under any circumstance be a value entry in a mix of #1. and #2.

    The same then must apply for line 10, 11 etc. test VBA.xlsm

    I am a total VBA newbie so please be gentle :-)

    Thanks

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,433
    Thanks
    371
    Thanked 1,456 Times in 1,325 Posts
    AnneMarie,

    Welcome to the Lounge as a new poster!

    I have a partial solution and I'll post it below but I need to apologize as I've just got off the road after 8 hours of hard driving and I'm a bit fried. The code below will handle the first part about the processing for Column H. It also handles the second part about making sure that if a value is placed in I-S it will nag the user to fill in the rest. However it does not force the issue as it needs little more code to accomplish that.

    Place this code in the Sheet Module for the testVBA sheet.
    Code:
    Option Explicit
    
    Private Sub Worksheet_Change(ByVal Target As Range)
    
    '*** Limiting the Worksheet_Change event to a firing when a single cell is changed
    
       Dim isect As Range
       
       Set isect = Application.Intersect(Range("H9:H" & Rows.Count), Target)
       If isect Is Nothing Then
         'Entry is not in Col H! Check for I-S
         Set isect = Application.Intersect(Range(Cells(Target.Row, 9).Address & _
                                           ":" & Cells(Target.Row, 19).Address), Target)
         If isect Is Nothing Then
           'Nothing to do exit
         Else
              If Application.WorksheetFunction.CountA(Range(Cells(Target.Row, 9).Address & _
                                                 ":" & Cells(Target.Row, 19).Address)) <> 11 Then
                MsgBox "You must fill all cells in Cols I-S for this row!", _
                       vbOKOnly + vbCritical, "Error: Incomplete data entry!"
                Application.EnableEvents = False
                  Cells(Target.Row, 9).Select
                Application.EnableEvents = True
              End If
         End If
    
       Else  '** Process Entry in Column H ****
         '***Prevent following code from refiring Change Event ***
         Application.EnableEvents = False
    '     MsgBox "A1 Changed", vbOKOnly + vbInformation, "Cell Changed"
    '***** Your code here *****
         If Application.WorksheetFunction.CountA(Range(Cells(Target.Row, 9).Address & _
                                                 ":" & Cells(Target.Row, 19).Address)) > 0 Then
           Target = ""
           With Target.Interior
               .Pattern = xlSolid
               .PatternColorIndex = xlAutomatic
               .ThemeColor = xlThemeColorDark1
               .TintAndShade = -0.349986266670736
               .PatternTintAndShade = 0
           End With
         Else
           With Target.Interior
               .Pattern = xlNone
               .TintAndShade = 0
               .PatternTintAndShade = 0
           End With
         End If
         Application.EnableEvents = True '*** Reset Events ***
       End If
    
    End Sub  'Sub Worksheet_Change(ByVal Target As Range)
    This at least gives you a start. I'll check back tomorrow after I finally get back home and finish the code is someone else here doesn't do it or maybe you can figure it out from here.

    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  3. The Following User Says Thank You to RetiredGeek For This Useful Post:

    annemarie (2016-04-11)

  4. #3
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,433
    Thanks
    371
    Thanked 1,456 Times in 1,325 Posts
    AnneMarie,

    Ok, I think I have the whole puzzle solved or at least as much of it as I currently understand.

    A couple of things to remember about this code:
    1. The Worksheet_SelectionChange event will always fire after the Worksheet_Change event! This is taken into account in the code.
    2. If the user enteres a value in columns I-S and then uses the tab or arrow keys to move to another cell in the same row and stays within the I-S column range no message is generated.
    3. If the user uses the Enter key or an up or down arrow key to enter a value in cols I-S then if there are any empty cells in the row the value was entered in columns I-S an error message will be displayed and the cursor will automatically be located in the left most column, in the I-S range, that does not have a value.
    4. If the user enters a non-numeric value in columns I-S it is considered a missing data item and will generate the error message and the cursor will be located there if there are no non-blank cells to its left.


    Code:
    Option Explicit
    
    '*** Public Variables for communication between subroutines ***
    
    Public bDataErrorCondition As Boolean
    Public rngPreviousCell     As Range
    
    Private Sub Worksheet_Change(ByVal Target As Range)
    
       Dim iSect         As Range
       Dim iItoSCount    As Integer
       Dim iItoSCountA   As Integer
       Dim iItoSLocation As Integer
       
       If Target.Row < 9 Then Exit Sub
       
       Set rngPreviousCell = Nothing
       bDataErrorCondition = False
       
       Set iSect = Application.Intersect(Range("H9:H" & Rows.Count), Target)
       
       If iSect Is Nothing Then    '*** Entry is not in Col H! Check for I-S ***
         Set iSect = Application.Intersect(Range(Cells(Target.Row, 9).Address & _
                                           ":" & Cells(Target.Row, 19).Address), Target)
         If iSect Is Nothing Then  '*** Entry is not in I-S Nothing to do exit ***
           Exit Sub
           
         Else
              iItoSCount = Application.WorksheetFunction.Count(Range(Cells(Target.Row, 9).Address & _
                        ":" & Cells(Target.Row, 19).Address))
              iItoSCountA = Application.WorksheetFunction.CountA(Range(Cells(Target.Row, 9).Address & _
                        ":" & Cells(Target.Row, 19).Address))
                        
              If (iItoSCount <> 11 And iItoSCount <> 0) Or (iItoSCountA <> iItoSCount) Then
                bDataErrorCondition = True
                Application.EnableEvents = False
                
                For iItoSLocation = 9 To 19
                   If Cells(Target.Row, iItoSLocation).Value = "" Or Not _
                      Application.WorksheetFunction.IsNumber(Cells(Target.Row, iItoSLocation)) Then
                     Set rngPreviousCell = Cells(Target.Row, iItoSLocation)
                     Exit For
                   End If
                Next iItoSLocation
                
                Application.EnableEvents = True
                
              Else   '*** Clear Error Variables ***
                Set rngPreviousCell = Nothing
                bDataErrorCondition = False
              End If
              
         End If   '*** iSect Is Nothing ***
    
       Else  '** Process Entry in Column H ****
       
         '***Prevent following code from refiring Change Event ***
         Application.EnableEvents = False
         If Application.WorksheetFunction.CountA(Range(Cells(Target.Row, 9).Address & _
                                                 ":" & Cells(Target.Row, 19).Address)) > 0 Then
           Target = ""
           With Target.Interior
               .Pattern = xlSolid
               .PatternColorIndex = xlAutomatic
               .ThemeColor = xlThemeColorDark1
               .TintAndShade = -0.349986266670736
               .PatternTintAndShade = 0
           End With
         Else
           With Target.Interior
               .Pattern = xlNone
               .TintAndShade = 0
               .PatternTintAndShade = 0
           End With
         End If
         Application.EnableEvents = True '*** Reset Events ***
       End If
    
    End Sub  'Sub Worksheet_Change(ByVal Target As Range)
    
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
      Dim iSect         As Range
    
      If bDataErrorCondition Then
      
        Set iSect = Application.Intersect(Range(Cells(rngPreviousCell.Row, 9).Address & _
                                           ":" & Cells(rngPreviousCell.Row, 19).Address), Target)
                                           
        If iSect Is Nothing Then '*** User moved outside input range ***
          Application.EnableEvents = False
          rngPreviousCell.Select
          Application.EnableEvents = True
        
          MsgBox "You must fill all cells in Cols I-S for row " & _
                  ActiveCell.Row() & "!" & vbCrLf & vbCrLf & _
                  "Entries MUST be a numeric value!", _
                 vbOKOnly + vbCritical, "Error: Incomplete data entry!"
    
        End If 'iSect
        
      End If   'bDataErrorCondition
      
    End Sub  'Worksheet_SelectionChange(ByVal Target as Range)
    Test File: Conditional Cell Locks.xlsm

    HTH
    Last edited by RetiredGeek; 2016-04-09 at 22:42.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  5. The Following User Says Thank You to RetiredGeek For This Useful Post:

    annemarie (2016-04-11)

  6. #4
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,820
    Thanks
    133
    Thanked 481 Times in 458 Posts
    Hi RG

    Welcome to the world of Danish plumbing!
    I looked at your posted file, and thought maybe AnneMarie meant column [G] rather than column [H], so I tweaked your code a bit.
    I also changed the formula in column [T] (it seems to make more sense to me).

    1. If you enter a value in column [G], it will change the cell colours in column [I:S] to show data entry in [I:S] is not allowed.
    2. If you start entering a cell in cols [I:S], the required cells will be set to 'pink', until ALL required entries are made.
    3. If you delete all cells in [I:S] and/or [G], the record becomes 'empty' again
    4. If you try and delete cells in more than one row, this is not allowed.
    5. If you try and enter a value in column [G] when there are pre-existing values in [I:S], the cell entry will be disallowed.
    6. If you try and enter in columns [I:S] when there is a pre-existing value in [G], the cell entry will be disallowed.

    I like what you did with the cellpointer selection change RG. Very nice.
    I'm sure my posted file can be tweaked too.

    I used some different colours for setting the cell interior background - I added an extra sheet with the available vba names.

    zeddy
    Attached Files Attached Files
    Last edited by zeddy; 2016-04-10 at 11:39.

  7. The Following User Says Thank You to zeddy For This Useful Post:

    annemarie (2016-04-11)

  8. #5
    New Lounger
    Join Date
    Apr 2016
    Posts
    2
    Thanks
    3
    Thanked 0 Times in 0 Posts

    Question Thanks :-) ... BUT.....

    Hi RG and Zeddy

    I tried both your suggestions - THANKS btw for taking the time to help me!

    And I can see I made an error in my description of the task.

    I am enclosing a more updated version of the previous spreadsheet. The one we're working in is called "Delaftale 1". PLEASE NOTE I will be adding further sheets, entitled "Delaftale 2", "Delaftale 3" etc. through to "Delaftale 7".

    This revised spreadsheet needs to be used as quantity quoted in Column F is applicable for ALL departments. However, if the supplier wishes to differentiate his prices, then the quantity in column F needs to be divided across the departments (now in the columns I, K, M, O, Q, S, U, W, Y - all coloured in grey). Entries can be made only in the yellow columns.

    Entry of values can EITHER be a single unit Price, to be entered in column G (not H as I had stated previously) applicable to all departments (column I-AD)
    OR, if the supplier does not wish to quote a single unit Price, then he can enter differentiated prices pr. department (yellow columns I-AD).

    The idea being, either the Price is the same pr. item for each department, OR there are specific variables within each department which calls for differentiated prices.

    Column H is a calculation field ($F9*$G9) and will be locked for entry when the sheet is complete. Similarly, columns AE and AF are calculation fields and will be locked for entry when the sheet is complete. To make it easy for suppliers, I always ask them to enter data ONLY in YELLOW fields / columns. The remaining columns will be locked when I am ready to send out the tender. The reason for this is that we have previously experienced suppliers changing the contents of other fields / columns e.g. in the quantities. This makes their bid look cheaper than competitors' bids.

    Note: Columns H and AE cannot BOTH be >0 as this would mean supplier has entered values that are BOTH single unit Price and differentiated.


    So here are 2 scenarios:


    Scenario #1: Line 9: supplier wishes to enter a single unit Price in column G. Column H is automatically updated as it is a calculation field. Columns I-AD for that line turn orange and the supplier cannot enter any data at all in these fields.

    Scenario #2: Line 10: supplier wishes to enter differentiated prices and so does NOT enter any value in column G. Instead, he starts his entry in ANY of the columns yellow columns to the right of Column H (J, L, N, P, R, T, V, X, Z, AB, AD) In this instance, column G turns orange and is locked for entry.

    Perhaps this removes the need for error boxes? Which I would need to translate to Danish anyway :-)

    I am sorry if my explanations / request sound muddled :-)

    Thanks again :-)
    Anne Marie
    Attached Files Attached Files

  9. #6
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,820
    Thanks
    133
    Thanked 481 Times in 458 Posts
    Hi Annemarie

    Can the supplier leave some of the yellow cells 'empty' in columns after H, (if they choose NOT to enter a value in column G)?
    In column U and Column W of your sample file, you have values like 0.1 and 0.3 - shouldn't these be whole numbers????

    zeddy

Tags for this Thread

Posting Permissions

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