using vba code on two cell columns

[helwel]

i googled some vba code for what i want to do. but in trying to put a few commands together. what i want to do doesnt work.
i have a 5 column worksheet, one page worth. 1- i want to lock column C when data is entered. i also want to ask a question whether the data is okay before locking. 2- when the 4 columns are filled in , i want to automatically record user with date and time in the 5th column.

the below asks me the question for every column field , not just column C that i want to lock.
and the user/date fills in for all lines 7 thru 44 in column e , not just the current line i am entering on.
and then the excel freezes

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel_c As Range
Dim cel_e As Range
On Error Resume Next
Set cel_c = Intersect(Range("c7:c44"), Target)
Set cel_e = Intersect(Range("e7:e44"), Target)
For Each cel_c In Target


If cel_c.Value <> "" Then
check = MsgBox("Is this entry correct? This cell cannot be edited after entering a value.", vbYesNo, "cell lock definition")
If check = vbYes Then
Target.Worksheet.Unprotect Password:="secret"
cel_c.Locked = True
cel_e = Format(Date, "mm/dd/yyyy") & " at " & Format(Time, "hh:mm AMPM") & " by " & Application.UserName
Else
cel_c.Value = ""
Target.Worksheet.Protect Password:="secret"
End If
End If
Next cel
End Sub

 

[Joe4]

Welcome to the Board!

You are not cycling through the cell correctly.

Note that "Target" is the cell just updated. If you want to see if that cell falls in a certain range (like C7:C44), you can do it like this:

Dim cel_c as Range
Dim cell as Range

Set cel_c = Intersect(Range("C7:C44"),Target)

If Not cel_c is Nothing Then
    For each cell in cel_c
        ....
    Next cell
End If

Also note that if you are updating any cell values within the code, you should Disable Event Code, so that the change doesn't trigger this code to run again (if you are not careful, you can get caught in an endless loop!). But you also need to turn it back on after making all your changes, or else other changes you manually make won't trigger the code to run.

So, let's say that in your code above, you want to make sure that the value you just entered is in ALL CAPS (using the UCASE function). So, this is what you would put between the For...Next loop:

Application.EnableEvents = False
cell = Ucase(cell)
Application.EnableEvents = True

 

[Logit]

.
I believe this will do what you want.

Paste into the Sheet level module :

Option Explicit


Function InRange(Range1 As Range, Range2 As Range) As Boolean
' returns True if Range1 is within Range2
Dim InterSectRange As Range
Set InterSectRange = Application.Intersect(Range1, Range2)
InRange = Not InterSectRange Is Nothing
Set InterSectRange = Nothing
End Function




Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If InRange(ActiveCell, Range("c7:c44")) Then
        ActiveSheet.Unprotect "secret"
    Else
        Exit Sub
    End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel_c As Range
Dim cel_e As Range
Dim cell As Range
Dim check As Variant
On Error Resume Next


Set cel_c = Intersect(Range("c7:c44"), Target)
Set cel_e = Intersect(Range("e7:e44"), Target)


    If Not cel_c Is Nothing Then
        For Each cell In cel_c
            If cel_c.Value <> "" Then
            check = MsgBox("Is this entry correct? This cell cannot be edited after entering a value.", vbYesNo, "cell lock definition")
                
                If check = vbNo Then
                    cel_c.Value = ""
                    cel_c.Offset(0, 1).Value = ""
                    cel_c.Locked = True
                    Target.Worksheet.Protect Password:="secret"
                    Exit Sub
                End If
                
                If Not check = vbYes And Not cel_c.Value Then
                    cel_c.Offset(0, 1).Value = Format(Date, "mm/dd/yyyy") & " at " & Format(Time, "hh:mm AMPM") & " by " & Application.UserName
                    cel_c.Locked = True
                    Target.Worksheet.Protect Password:="secret"
                End If
            
            End If
        Next cell
    End If
End Sub

Download sample workbook : https://www.amazon.com/clouddrive/share/1Ydi9pb949L0UrknO4JxIImypD6pvH8H0DJKxrn8pLj

 

[Joe4]

Logit:

This section of code seems like it could be problematic:

    If Not cel_c Is Nothing Then
        For Each cell In cel_c
            If cel_c.Value <> "" Then

as cel_c could conceivably be a multi-cell range.

I think that third line should be:

If cell.Value <> "" Then

 

[Logit]

.
The presence of the MsgBox prevents the entry of data into more than one cell.

If I correctly understand your reasoning.

 

[Joe4]

It is just a very odd construct.
Typically, if you iterate through the cells in a range ("For each cell in cel_c"), and work you do within that block is done on that particular cell, and not the entire range (cel_c).
Otherwise, what is the whole point of iterating through the range in the first place? It would seem to be unnecessary.

 

[Logit]

.
helwel:

I was reviewing some of my recent posts and discovered the code and workbook I gave you has an error. Hence, the Date / Time / User Name is not displaying in Col D when an entry is made in Col C.

My apologies for overlooking this. I have a working copy here (which I will post along with the code below) but apparently I grabbed a previous version of the workbook / code. Again, please accept
my sincere apologies for the error.

This is confirmed to work here :

Option Explicit


Function InRange(Range1 As Range, Range2 As Range) As Boolean
' returns True if Range1 is within Range2
Dim InterSectRange As Range
Set InterSectRange = Application.Intersect(Range1, Range2)
InRange = Not InterSectRange Is Nothing
Set InterSectRange = Nothing
End Function




Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If InRange(ActiveCell, Range("c7:c44")) Then
        ActiveSheet.Unprotect "secret"
    Else
        Exit Sub
    End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel_c As Range
Dim cel_e As Range
Dim cell As Range
Dim check As Variant
On Error Resume Next


Set cel_c = Intersect(Range("c7:c44"), Target)
Set cel_e = Intersect(Range("e7:e44"), Target)


    If Not cel_c Is Nothing Then
        For Each cell In cel_c
            If cel_c.Value <> "" Then
            check = MsgBox("Is this entry correct? This cell cannot be edited after entering a value.", vbYesNo, "cell lock definition")
                
                If check = vbNo Then
                    cel_c.Value = ""
                    cel_c.Offset(0, 1).Value = ""
                    cel_c.Locked = True
                    Target.Worksheet.Protect Password:="secret"
                    Exit Sub
                End If
                
                If check = vbYes Then
                    cel_c.Offset(0, 1).Value = Format(Date, "mm/dd/yyyy") & " at " & Format(Time, "hh:mm AMPM") & " by " & Application.UserName
                    cel_c.Locked = True
                    Target.Worksheet.Protect Password:="secret"
                End If
            
            End If
        Next cell
    End If
End Sub

Download workbook : https://www.amazon.com/clouddrive/share/VXXndi6pULMZKdogAOMfyzsTi2Xi33g0bcRavFumm4u

 

[helwel]

.. thanks. it kinda works. i think i understood the offset command, as i wanted to put userdate&time in column E after column C filled in , i changed the offset to a 2 and that worked.

in seeing the offset command, then i dont need cel_e defined? cel_e was for the userdate&time

only problem is when i go to the next row the columns are locked throughout the page. i only want the current line " column C" locked adding userdate&time (as it is doing) and any prior filled in "column C" rows to stay locked . and for the rest of the rows to be untouched till something keyed in .

 

[helwel]

also. i enter in Column C. and then my cursor goes to column D because i tab and then my question comes up. i answer NO . i tab back to column C to enter a new value and its Locked.

 

[helwel]

i thought i figured it out, but not fully. in the NO loop path i changed TRUE to FALSE. that let me reenter data, but i then also found out when i answer YES for that box of data i just re-entered, it doesnt get locked on the second go-around. if i answer YES the first time, it stays locked.