Moving code to a new location

X

XrayLemi

Board Regular
Joined
Aug 1, 2018
Messages
153
Office Version
  1. 365
Platform
  1. Windows
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.
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
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Sort by date Sort by votes
how about somewhere on that sheet you mark a column for that row with an x when first sent, then next time, if you can check a comparison first, add an x if it compares a and if no x then send, add x after

how to do the compare will be fiddly maybe
 
Upvote 0
Hello Mole,
First, thank you for the response. Second let me apologize up front. My skill / experience with VBA is EXTREMELY limited. If I don't get something right away, please don't get frustrated.

I don't know if adding an X would work in my case. The way the code is setup once the user enters a value in column M (usually y or yes) The entire row gets locked. Changes after that can't happen. Right now, as soon as you enter a value in H and go to the next cell, it launches the sub routine in the module. If you make an error and change the value in column H after you went to the next cell, it re-sends e-mails and adds the correct value to the list as well as the incorrect first value. I'm trying to move the code to where the vbYes is. This way a user can change the value in "H" as many times as they want. Only after they hit yes on the message box will it launch the sub-routine in the module. Then lock the row. I guess what I mean is, only if the criteria is met in both columns H and M will the module run the sub. not just the criteria in column H.

Does that better explain my dilemma?
Thanks ,
Jim
 
Upvote 0
Okay,
So I added a column. Column Q. This is the trigger for the new case select code I have written. It follows a similar pattern to the first case select statements in my code which work fine. The new code gives me an error. Case else outside case select. If it is set in the same format why do I get the errors?
Here is my new code.
VBA Code: 
Dim p As Range, z As Range
     Set p = Range("Q6:Q5000")
     Set p = Intersect(Target, p)
     If Not p Is Nothing Then
      Application.EnableEvents = False
     For Each p In z
     Select Case True
     Case 17 = z.Column 'Q
     If z.Value = "E" Then
       Call Copyemail
       Check = MsgBox("Are your entries correct?" & vbCrLf & "After entering yes, These values CANNOT be changed.", vbYesNo + vbQuestion, "Cell Lock Notification")
        If Check = vbYes Then
         Target.Rows.EntireRow.Locked = True
         Cells(z.Row + 1, "B").Locked = False
         Cells(z.Row + 1, "C").Locked = False
         Cells(z.Row + 1, "D").Locked = False
         Cells(z.Row + 1, "F").Locked = False
         Cells(z.Row + 1, "G").Locked = False
         Cells(z.Row + 1, "I").Locked = False
         Cells(z.Row + 1, "J").Locked = False
         Cells(z.Row + 1, "K").Locked = False
         Cells(z.Row + 1, "L").Locked = False
         Cells(z.Row + 1, "M").Locked = False
     ElseIf z.Value = "L" 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
         Target.Rows.EntireRow.Locked = True
         Cells(z.Row + 1, "B").Locked = False
         Cells(z.Row + 1, "C").Locked = False
         Cells(z.Row + 1, "D").Locked = False
         Cells(z.Row + 1, "F").Locked = False
         Cells(z.Row + 1, "G").Locked = False
         Cells(z.Row + 1, "I").Locked = False
         Cells(z.Row + 1, "J").Locked = False
         Cells(z.Row + 1, "K").Locked = False
         Cells(z.Row + 1, "L").Locked = False
         Cells(z.Row + 1, "M").Locked = False
     Else
         Cells(z.Row, "M").Value = ""
        End If
      Case Else
    End Select
   Next z
   End If
Where do I go now?
Thanks again,
Jim
 
Upvote 0
Okay so now I am at wits end. have tried everything I can think of, still no luck. This is my latest attempt. I also tried this version with the duplicate lock/unlock code removed. I thought it may have been causing problems. I know it is not good practice to use goto but everything else I have tried has failed. This at least compiles, but it stops working after the date code. Then it skips the next set of code (The part I am trying to alter) and jumps to the code that saves the file.
Here is the latest code
VBA Code: 
Private Sub CommandButton1_Click()
    UpdateDataFromMasterFile
End Sub
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
 
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

'The code works fine to here then stops working

  Dim p As Range, z As Range
  Set p = Union(Range("Q6:Q5000"), Range("M6:M5000"))
  Set p = Intersect(Target, p)
  If Not p Is Nothing Then
   Application.EnableEvents = False
   For Each z In p
    Select Case True
     Case 17 = z.Column 'Q
      If z.Value = 1 Then GoTo Line1 Else GoTo Line2
Line1:
    Call Copyemail
      
Line2:
     Check = MsgBox("Are your entries correct?" & vbCrLf & "After entering yes, These values CANNOT be changed.", vbYesNo + vbQuestion, "Cell Lock Notification")
      If Check = vbYes Then
       Cells(z.Row + 1, "B").Locked = False
       Cells(z.Row + 1, "C").Locked = False
       Cells(z.Row + 1, "D").Locked = False
       Cells(z.Row + 1, "F").Locked = False
       Cells(z.Row + 1, "G").Locked = False
       Cells(z.Row + 1, "I").Locked = False
       Cells(z.Row + 1, "J").Locked = False
       Cells(z.Row + 1, "K").Locked = False
       Cells(z.Row + 1, "L").Locked = False
       Cells(z.Row + 1, "M").Locked = False
      Else
       Cells(z.Row, "M").Value = ""
      End If
            Case Else
    End Select
   Next z
  End If

'Then the code starts working again here

    If Not Intersect(Target, Me.Range("M6:M5000")) Is Nothing Then
        ThisWorkbook.Save
      Target.Rows.EntireRow.Locked = True
    End If
     Application.EnableEvents = True
End Sub
 
Upvote 0
Okay, I changed the code again. Now I have found something peculiar. If I enter data as I need, I have a formula in column Q that returns a value of 1 if conditions are met. In my code, case 17 says if the cell value in column Q is anything but blank, it should call my Copyemail module. However it won't run if the value goes in automatically with the formula. Yet if I go in and manually enter a value in column Q, the sub routine in my module it runs as expected. Why would it do this? Here is the new code.
VBA Code: 
Private Sub CommandButton1_Click()
    UpdateDataFromMasterFile
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r As Range, c As Range
  Set r = Union(Range("J6:J5000"), Range("G6:G5000"), Range("Q6:Q5000"))
  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 17 = c.Column 'Q
        If c.Value <> "" Then
         Call Copyemail
         End If
       Case Else
    End Select
   Next c
  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, z As Range
     Set p = Range("M6:M5000")
     Set p = Intersect(Target, p)
     If Not p Is Nothing Then
   Application.EnableEvents = False
     For Each z In p
      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
            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, "M").Locked = False
            Else
            Cells(p.Row, "M").Value = ""
            End If
          End If
      Case Else
    End Select
   Next z
 End If
If Not Intersect(Target, Me.Range("M6:M5000")) Is Nothing Then
  ThisWorkbook.Save
 End If
     Application.EnableEvents = True
End Sub
 
Upvote 0
The answer to this problem came in the following post.

This code Runs a macro for every row in the range I only need it to run the current or active row. How do I change it?​

Here is the link.

www.mrexcel.com

This code Runs a macro for every row in the range I only need it to run the current or active row. How do I change it?

Hi again all. The following code works as written. BUT, every time I enter a new row of data, it calls the macro for every cell in the range with a value "" . I only need it to call the macro for the current or active row. What needs to be changed? Here is the code Dim Cell As Range For...
www.mrexcel.com www.mrexcel.com

 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

A
  • Question
After User Enters A Value (Validation List), Not Automatically Advancing To Next Cell As Per "Select"
Replies
1
Views
176
Ark68
A
K
  • Question
VBA with password-protected sheet
Replies
5
Views
281
Logit
Logit
X
  • Question
Locking/unlocking a cell with a Combo Box value Mouse click problem
Replies
0
Views
477
XrayLemi
X
E
  • Question
Auto close spreadsheet timer not working correctly
2
Replies
17
Views
774
eli_m
E
W
  • Solved
Code for rows of cells returning reverse-order values.
Replies
5
Views
164
Worksong
W

Forum statistics

Threads
1,214,920
Messages
6,122,279
Members
449,075
Latest member
staticfluids

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top