Results 1 to 9 of 9
  1. #1
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts

    Follow Up to Jaggi's Closed Post

    The OP can be found here:

    I've been traveling so I didn't have a clear block of time to work on this problem and It was marked solved. Well I finally got the code working the way I wanted it so it thought I'd post it in case it helps Jaggi or someone else.

    Notes:

    1. I've rearanged some of the existing code for a, IMO, cleaner flow.
    2. I removed the For Each block as there will only be one cell in the rChange variable anyway and thus eliminated the need for rChange. Also included a check to get out if there is more than one cell in the selected range.
    3. Included a check to make sure (or as sure as you can be) that the entry value is a date and using some code I previously wrote that that date falls within specified parameters. See comment in code.

    Worksheet Module:
    Code:
    Sub Worksheet_Change(ByVal Target As Excel.Range)
    
    'Requires Function: bVerifyTextBoxDate in Standard Module
    
       Dim rCell As Range
    
       On Error GoTo ErrHandler
       Set rCell = Intersect(Target, Range("A:A"))
       
       If Not rCell Is Nothing Then
       
         If rCell.Count = 1 Then
           ActiveSheet.Unprotect
           Application.EnableEvents = False
            
           With rCell
           
    '*** NOTE: bVerifyTextBoxDate arugment #2 sets the lower limit for the
    '          date entry, in this case the previous record's date and
    '          argument #3 sets the upper limit, in this case the previous
    '          records date + 7...ADJUST AS NECESSARY
    
               If bVerifyTextBoxDate(.Value, _
                  .Offset(-1, 0).Value, _
                  .Offset(-1, 0).Value + 7) Then
                 .Locked = True             'lock cell
                 .Offset(0, 1).Value = Now
                 .Offset(0, 1).NumberFormat = "hh:mm:ss"
               Else
                 rCell.Offset(0, 1).Clear
               End If
               
           End With 'Rcell
           
         End If  'rCell.Count
         
       End If
       
       GoTo ExitHandler:
       
    ErrHandler:
       MsgBox Err.Description
       
    ExitHandler:
       Set rCell = Nothing
       Set rChange = Nothing
       Application.EnableEvents = True
       ActiveSheet.Protect
       Exit Sub
       
    End Sub
    Main Module Function Code:
    Code:
    Option Explicit
    
    
    #Const cModeDebug = False  '*** Set to True when debugging & False for Production
    
    '                         +-------------------------+             +----------+
    '-------------------------|   bVerifyTextBoxDate()  |-------------| 08/26/10 |
    '                         +-------------------------+             +----------+
    
    Public Function bVerifyTextBoxDate(zDateValue As String, _
                                       Optional vLowerLimit As Variant, _
                                       Optional vUpperLimit As Variant) As Boolean
                                       
       Dim zErrorData As String
    
    On Error GoTo DateError
    
        bVerifyTextBoxDate = True
    
        If Not IsDate(zDateValue) Then
          bVerifyTextBoxDate = False
          Exit Function
        End If
        
        If Not IsMissing(vLowerLimit) Then
         If CDate(zDateValue) <= CDate(vLowerLimit) Then
           bVerifyTextBoxDate = False
         End If
        End If
        
        If Not IsMissing(vUpperLimit) Then
         If CDate(zDateValue) >= CDate(vUpperLimit) Then
           bVerifyTextBoxDate = False
         End If
        End If
        
    #If cModeDebug Then
        zErrorData = "Lower Limit is GREATER than or Equal to Upper Limit!" & _
                   vbCrLf & vbCrLf & _
                   "Data Value Passed: " & vbTab & vbTab & zDateValue & vbCrLf & _
                   "Lower Limit Passed: " & vbTab & vbTab & _
                   IIf(Not IsMissing(vLowerLimit), vLowerLimit, "None") & vbCrLf & _
                   "Upper Limit Passed: " & vbTab & vbTab & _
                   IIf(Not IsMissing(vUpperLimit), vUpperLimit, "None")
        If (Not IsMissing(vLowerLimit)) And _
           (Not IsMissing(vUpperLimit)) Then
          If CDate(vLowerLimit) >= CDate(vUpperLimit) Then
            MsgBox zErrorData, vbOKOnly + vbCritical, _
                   "bVerifyTextBoxDate()- Error: Invalid Call to Function"
          End If
        End If
    #End If
        
        Exit Function
        
    DateError:
    
      zErrorData = "One of the data values passed can not be converted " & _
                   "into a date!" & vbCrLf & _
                   "Data Value Passed: " & vbTab & vbTab & zDateValue & vbCrLf & _
                   "Lower Limit Passed: " & vbTab & vbTab & _
                   IIf(Not IsMissing(vLowerLimit), vLowerLimit, "None") & vbCrLf & _
                   "Upper Limit Passed: " & vbTab & vbTab & _
                   IIf(Not IsMissing(vUpperLimit), vUpperLimit, "None")
                   
      Select Case Err()
            Case 13:    '*** Type Mismatch Error - Can't convert to date ***
                MsgBox zErrorData, _
               vbCritical + vbOKOnly, _
               "bVerifyTextBoxDate()- Error: Argument Type Mismatch"
               Exit Function
            Case Else
               MsgBox "Error Number: " & Format(Err.Number) & vbCrLf & _
                      "Error Description: " & Err.Description & vbCrLf & vbCrLf & _
                      "Contact your system programmer immediately!" & vbCrLf & vbCrLf & _
                      zErrorData, vbOKOnly + vbCritical, _
                      "bVerifyTextBoxDate()- Error: Unknown Error"
    
      End Select
    
        
    End Function    '*** bVerifyTextBoxDate() ***
    Note: you can strip the debugging code out if you don't want it or use it as a template on how to use some of the conditional compilation debugging commands.

    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  2. #2
    2 Star Lounger
    Join Date
    Feb 2015
    Posts
    128
    Thanks
    19
    Thanked 1 Time in 1 Post

    Post

    Hi RetiredGreek

    Thanks for sharing your view on the thread.

    I tried using the code in the attached sample file. I am able to add the date in column A in a cell. After that it is not allowing me to add anything in anycell. I want to freeze or restruct users to add date in one column not in entire sheet. Is this possible via VBA.

    Regards,
    JD
    Attached Files Attached Files

  3. #3
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,826
    Thanks
    136
    Thanked 482 Times in 459 Posts
    Hi Jaggi

    You need to first unprotect the sheet (no password required in RG's demo file).
    Then, select the range of cells in column [A] that you want to allow for data entry, and change the cell format for protection to be 'unlocked'.

    zeddy

  4. #4
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Jaggi,

    Ok maybe this explanation will help?

    When you create a new workbook/sheet the default setting for cell protection is Locked!
    Locked.JPG
    Of course, this has no effect until you PROTECT the sheet.

    Thus, what you need to do to setup the workbook, if I am reading the situation correctly, is:
    1. UnProtect the Worksheet.
    2. UnLock (remove the check mark from the Locked option in the Protection tab of the Format Cells dialog) the ENTIRE worksheet!
      Note: You can select the entire workbook by clicking in the left hand corner where the Col Letters and Row Numbers meet. Then do the unlock in one operation.
    3. Then go back and Lock column A as far down as you already have data.
    4. Lock the Entire Column B. (Select by click in on the Col Letter)
    5. Protect the Worksheet.


    The macros should now work as they are designed, this is assuming that only Cols A & B are to be locked once a date is entered. If other cells are also to be locked you need to specify exactly which ones in the row need this protection.

    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  5. #5
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Jaggi,

    This thing has been vexing me for a couple of reasons but it dawned on me that if you are assigning a time to a date it MUST be the current date otherwise the "assigned" time would be meaningless?

    If this is the case then why not just have the code assign the date too?

    This code will ignore what the user puts in the cell. All the user has to do is double-click the cell then hit Enter or tab or and arrow and the current date and time will be assigned and the cursor placed in column C. HTH
    Code:
    Sub Worksheet_Change(ByVal Target As Excel.Range)
    
    'Requires Function: bVerifyTextBoxDate in Standard Module
    
       Dim rCell As Range
    
       On Error GoTo ErrHandler
       Set rCell = Intersect(Target, Range("A:A"))
       
       If Not rCell Is Nothing Then
       
         If rCell.Count = 1 Then
           ActiveSheet.Unprotect
           Application.EnableEvents = False
            
           With rCell
               .Value = Date
               .Locked = True             'lock cell
               .Offset(0, 1).Value = Now
               .Offset(0, 1).NumberFormat = "hh:mm:ss"
               .Offset(0, 2).Select
          End With 'Rcell
           
         End If  'rCell.Count
         
       End If
       
       GoTo ExitHandler:
       
    ErrHandler:
       MsgBox Err.Description
       
    ExitHandler:
       Set rCell = Nothing
       Set rChange = Nothing
       Application.EnableEvents = True
       ActiveSheet.Protect
       
    End Sub    'Worksheet_Change()
    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  6. #6
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,826
    Thanks
    136
    Thanked 482 Times in 459 Posts
    Hi RG

    If you are going to use double-click, why not get rid of the Sub Worksheet_Change event, and just use this code:
    Code:
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    'CHECK FOR DOUBLE-CLICK IN COLUMN [A]..
    If Target.Column = 1 Then           'double-click in column [A]
        If Target.Value = "" Then       'check for empty cell
        ActiveSheet.Unprotect           'unlock sheet
        Application.EnableEvents = False    'turn events OFF while making changes
        With Target                     'use shortcut
            .Value = Date               'enter today's date
            .Locked = True              'lock cell
            .Offset(0, 1).Value = Now   'add timestamp to adjacent cell
            .Offset(0, 1).NumberFormat = "hh:mm:ss" 'format cell
            .Offset(1).Select           'move cellpointer to next row down
            End With                    'end of shortcut
        End If                          'end of test for empty cell
    End If                              'end of test for column [A]
    
    Application.EnableEvents = True     'turn events back ON
    ActiveSheet.Protect                 'protect sheet
    
    End Sub
    ..now you don't need to " then hit Enter or tab or and arrow "

    zeddy
    Last edited by zeddy; 2015-05-14 at 04:55.

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

    RetiredGeek (2015-05-14)

  8. #7
    2 Star Lounger
    Join Date
    Feb 2015
    Posts
    128
    Thanks
    19
    Thanked 1 Time in 1 Post
    Hi Guys

    This is awesome. I tried both the option and the outcome is fitting into my requirement.

    Thanks for your help Guys.

    Cheers
    JD

  9. #8
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Quote Originally Posted by zeddy View Post
    Hi RG

    If you are going to use double-click, why not get rid of the Sub Worksheet_Change event, and just use this code:
    zeddy
    Right you are! All I can say in my defense is it was late and I was in the middle of a crisis with my Wife's machine (see Maintenance) and a bit stressed...that's my story and I'm sticking to it!
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  10. #9
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,826
    Thanks
    136
    Thanked 482 Times in 459 Posts
    Hi RG

    A wife is irreplaceable. Machines are not.

    Use this Excel method:
    IF IsNull(Warranty) And Void Then BuyHerANew1

    zeddy
    Last edited by zeddy; 2015-05-14 at 10:59.

Posting Permissions

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