Good morning all.
I have written-copied-manipulated code that does what it is written to do. However,in some cases it is causing duplication. I need to change some of the code's location and that's where i'm stuck.
The part of the code in question is written so as soon as you finish entering data in column H, it calls a sub routine from a module. That module code copies the data from column H to another workbook and sends e-mails letting others know it has been done. However the way I did this, if you go back and change the data (maybe you misspelled something) it re-sends the new data and new e-mails creating duplicates. Later in the coding, I have got code that opens a message box asking if your entries are correct. If yes, it then locks the current row of cells and unlocks certain cells the next row. I need to move the copy and e-mail code to go with the code that locks the cells so if a change is made to column H it won't copy data or send e-mails until the data in the row is complete and ready to be locked.
Here is the code as written. I added comments where the code is, and where I need it to be.
I have tried allot of different ways to move it but can't get it to work.
Hope you folks can help.
Thanks in advance,
Jim
I have written-copied-manipulated code that does what it is written to do. However,in some cases it is causing duplication. I need to change some of the code's location and that's where i'm stuck.
The part of the code in question is written so as soon as you finish entering data in column H, it calls a sub routine from a module. That module code copies the data from column H to another workbook and sends e-mails letting others know it has been done. However the way I did this, if you go back and change the data (maybe you misspelled something) it re-sends the new data and new e-mails creating duplicates. Later in the coding, I have got code that opens a message box asking if your entries are correct. If yes, it then locks the current row of cells and unlocks certain cells the next row. I need to move the copy and e-mail code to go with the code that locks the cells so if a change is made to column H it won't copy data or send e-mails until the data in the row is complete and ready to be locked.
Here is the code as written. I added comments where the code is, and where I need it to be.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, c As Range
Set r = Union(Range("J6:J5000"), Range("G6:G5000"))
Set r = Intersect(Target, r)
If Not r Is Nothing Then
Application.EnableEvents = False
For Each c In r
Select Case True
Case 10 = c.Column 'J
If c.Value = "" Then
Cells(c.Row, "L").Value = ""
Cells(c.Row, "L").Locked = True
Else
Cells(c.Row, "L").Locked = False
End If
Case 7 = c.Column 'G
If c.Value = "Not Listed" Then
Cells(c.Row, "H").Locked = False
Else
Cells(c.Row, "H").Locked = True
Cells(c.Row, "H").Value = ""
End If
Case Else
End Select
Next c
End If
'This is the code I need moved
If Target.Cells.Count > 6 Then Exit Sub
If Not Intersect(Target, Range("H6:H5000")) Is Nothing Then
With Target(1, 6)
Call Copyemail 'my module subroutine
End With
End If
If Target.Cells.Count > 3 Then Exit Sub
If Not Intersect(Target, Range("C6:C5000")) Is Nothing Then
With Target(1, 3)
.Value = Date
.EntireColumn.AutoFit
End With
End If
Dim p As Range
Set p = Range("M6:M5000")
Set p = Intersect(Target, p)
For Each p In Target
Select Case True
Case 13 = p.Column 'M
If p.Value <> "" Then
Check = MsgBox("Are your entries correct?" & vbCrLf & "After entering yes, These values CANNOT be changed.", vbYesNo + vbQuestion, "Cell Lock Notification")
If Check = vbYes Then 'I need it moved somewhere below this point, but can't figure out where.
Target.Rows.EntireRow.Locked = True
Cells(p.Row + 1, "B").Locked = False
Cells(p.Row + 1, "C").Locked = False
Cells(p.Row + 1, "D").Locked = False
Cells(p.Row + 1, "F").Locked = False
Cells(p.Row + 1, "G").Locked = False
Cells(p.Row + 1, "I").Locked = False
Cells(p.Row + 1, "J").Locked = False
Cells(p.Row + 1, "K").Locked = False
Cells(p.Row + 1, "L").Locked = False
Cells(p.Row + 1, "M").Locked = False
Else
Cells(p.Row, "M").Value = ""
End If
End If
Case Else
End Select
Next p
If Not Intersect(Target, Me.Range("M6:M5000")) Is Nothing Then
ThisWorkbook.Save
End If
Application.EnableEvents = True
End Sub
I have tried allot of different ways to move it but can't get it to work.
Hope you folks can help.
Thanks in advance,
Jim