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?

[XrayLemi]

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 Each Cell In Range("Q6:Q5000")
    If Cell.Value <> "" Then Call Copyemail
Next Cell

What I think I need is something like this. I know I'm missing something, but I can't get it to work.

 Dim Cell As Range
Range = ("Q6:Q5000")
    If Rows(ActiveCell.Row).Value <> "" Then
    Call Copyemail

Thanks,
Jim

 

[eduzs]

You must inform which range or cells need to be <> "" or the entire row?

 

[XrayLemi]

Hi Eduzs,
The entire row is not always complete with entries. Sometimes cells are blank on purpose. It is only column Q that matters. Also, the data that goes into column Q goes in by a formula consisting of conditions of two other columns of data. If it helps, the data that goes in Q is only a single digit or letter. Which ever works better is fine.
Thanks,
Jim

 

[eduzs]

Try:

If cells(selection.row,"Q")<>"" Then copyemail

 

[XrayLemi]

Hi Eduzs, I tried two new codes. The new one you just gave me. as well as the code I just tried below.
With both codes yours and mine, they began to call the sub after each entry in the row. So if I made 4 entries in the row it called the sub 4 times. Neither codes waited until column Q had an entry. It is only after the formula in Q compiles and gives a result other than "" that I want the sub to be called.

 Dim Xrg As Range
    Set Xrg = Range("Q6:Q5000")
    If Not Intersect(Xrg, Range("Q6:Q5000")) Is Nothing Then
    Call Copyemail
    End If

 

[Michael M]

You don't ned the entire range of "Q" ....if you only want to use the current or activerow, use

Sub MM1()
If Cells(Selection.Row, "Q") <> "" Then copyemail
End Sub

 

[eduzs]

This code does not make sense.
Each time you change "Q6:Q5000" range it will run, nothing wrong.
I'm not understanding what you mean with ""wait until column Q had a entry".
"If Cells(Selection.Row, "Q") <> "" Then copyemail" wil only run when value <> "" except if another runs.
You should review all the code.

Hi Eduzs, I tried two new codes. The new one you just gave me. as well as the code I just tried below.
With both codes yours and mine, they began to call the sub after each entry in the row. So if I made 4 entries in the row it called the sub 4 times. Neither codes waited until column Q had an entry. It is only after the formula in Q compiles and gives a result other than "" that I want the sub to be called.

Dim Xrg As Range
    Set Xrg = Range("Q6:Q5000")
    If Not Intersect(Xrg, Range("Q6:Q5000")) Is Nothing Then
    Call Copyemail
    End If

 

[XrayLemi]

Hi Guys.
I have not been on in a while so forgive the late response.

Michael M, I did use that exact code. Eduzs gave that to me in post #4. For some reason it gave me trouble. When I made an entry anywhere in the active row, it ran that line of code. If I made multiple entries in the same row, for example, Entries in Column B,C, D,I. Each entry in each column in the active row would run that line of code calling the subroutine over and over.

For both of you, Michael and Eduzs, I exited out of excel, rebooted, and re-opened the workbook. The first row of entries was fine. It worked as it should. I figured it must have been a glitch that was now gone. However, when I made entries in the next row, the subroutine should not have run. But, it did anyway, even with no entry in column Q. It appears that the code "went looking" for the last entry in Q and used that line of data when it called the subroutine.

I do not know if it matters, the user does not actually manually input the value in column Q. Column Q has a formula in it. My experience with VBA is extremely limited. I am not sure about the "selection. row" part of the line of code you both told me to use. Does it mean the code is actually looking for the user to manually select column Q?

I don't know if it helps, but here is the entire code from beginning to end.

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
 
    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 = z.Column 'M
        If z.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
            If Cells(Selection.Row, "Q") <> "" Then Copyemail
            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, "M").Locked = False
            
            Else
            Cells(z.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

 

[XrayLemi]

OKAY I think I finally got it!
I changed the code you guys told me to use slightly. Here is what I used.

If Cells(Application.ActiveCell.Row, 17).Value <> "" Then Copyemail

I am FAR from an expert, and I am not sure if I'm right. BUT, I thought if the user is not actively selecting the required cell, and the code is saying select. maybe that was my problem?

I am in the process of testing and so far so good. I hope I don't have to bug you guys about this again. But if I do, I know where to find you!

Thank you for pointing me in the right direction!
Jim