If Then VBA Script

[lilwillis3000]

Please help. I've been trying to come up with a VBA Script that says this

If column D equals anything but ***NAME NOT LISTED***, Then return "N/A" in that same row in column G.

I already have Data Validation to restrict editing in column G if column D is not ***NAME NOT LISTED***

 

[Michael M]

Why VBA, a formula will do the same thing.
In column "G", Drag down as required.

=IF(D30<>"***NAME NOT LISTED***","N/A","")

 

[lilwillis3000]

Why VBA, a formula will do the same thing.
In column "G", Drag down as required.

=IF(D30<>"***NAME NOT LISTED***","N/A","")

Because I still want users to fill in the unit name in Column G if it's not listed in Column D. If I do it this way, will they not write over the formula?

 

[Michael M]

Maybe this

Sub MM1()
 Dim lr As Long, r As Long
 lr = Cells(Rows.Count, "D").End(xlUp).Row
 For r = 30 To lr
    If Range("D" & r).Value <> "***NAME NOT LISTED***" Then
        Range("G" & r).Value = "N/A"
    End If
Next r
    End Sub

 

[lilwillis3000]

Maybe this

Sub MM1()
 Dim lr As Long, r As Long
 lr = Cells(Rows.Count, "D").End(xlUp).Row
 For r = 30 To lr
    If Range("D" & r).Value <> "***NAME NOT LISTED***" Then
        Range("G" & r).Value = "N/A"
    End If
Next r
    End Sub

Thanks but not quite. This makes everything N/A all the way down first. I want Column G to be clear until something other than ***NAME NOT LISTED*** is selected in Column D.

Also, I have to manually run the macro each time the change is made. How can I set it to run automatically after something is selected in Column D?

 

[Cubist]

This triggers when a value from cells D30 and below are changed. This should go into your sheet VB module, not the general. Try on a copy.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim changedCell As Range
    Dim intersectRange As Range
   
    ' Define the range of column D from D30 downwards
    Set intersectRange = Intersect(Target, Me.Range("D30:D" & Me.Rows.Count))
   
    If Not intersectRange Is Nothing Then
        Application.EnableEvents = False
       
        For Each changedCell In intersectRange
            If changedCell.Value <> "***NAME NOT LISTED***" Then
                Me.Cells(changedCell.Row, "G").Value = "N/A"
            Else
                Me.Cells(changedCell.Row, "G").ClearContents
            End If
        Next changedCell
       
        Application.EnableEvents = True
    End If
End Sub

 

[lilwillis3000]

This triggers when a value from cells D30 and below are changed. This should go into your sheet VB module, not the general. Try on a copy.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim changedCell As Range
    Dim intersectRange As Range
  
    ' Define the range of column D from D30 downwards
    Set intersectRange = Intersect(Target, Me.Range("D30:D" & Me.Rows.Count))
  
    If Not intersectRange Is Nothing Then
        Application.EnableEvents = False
      
        For Each changedCell In intersectRange
            If changedCell.Value <> "***NAME NOT LISTED***" Then
                Me.Cells(changedCell.Row, "G").Value = "N/A"
            Else
                Me.Cells(changedCell.Row, "G").ClearContents
            End If
        Next changedCell
      
        Application.EnableEvents = True
    End If
End Sub

Thanks but I Excel will not let me run it (bottom code). Every time I try to run it, it asks me to save the Macro Name and when I do, It starts a new line of code. What am I missing? I've compared it to the top code for a similar spreadsheet that works fine.

 

[rlv01]

Another variant to what @Cubist posted:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, R As Range
    
    Set rng = Me.Range("D30:D" & Me.Range("B" & Me.Rows.Count).End(xlUp).Row)
    
    If Not Intersect(rng, Target) Is Nothing Then
        Application.EnableEvents = False
        For Each R In rng
            If Trim(R.Value) = "***NAME NOT LISTED***" Then
                R.Offset(0, 3).Value = vbNullString
            Else
                R.Offset(0, 3).Value = "N/A"
            End If
        Next R
        Application.EnableEvents = True
    End If
End Sub

This code MUST go in a worksheet code module, not a general code module.

 

[lilwillis3000]

This triggers when a value from cells D30 and below are changed. This should go into your sheet VB module, not the general. Try on a copy.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim changedCell As Range
    Dim intersectRange As Range
 
    ' Define the range of column D from D30 downwards
    Set intersectRange = Intersect(Target, Me.Range("D30:D" & Me.Rows.Count))
 
    If Not intersectRange Is Nothing Then
        Application.EnableEvents = False
     
        For Each changedCell In intersectRange
            If changedCell.Value <> "***NAME NOT LISTED***" Then
                Me.Cells(changedCell.Row, "G").Value = "N/A"
            Else
                Me.Cells(changedCell.Row, "G").ClearContents
            End If
        Next changedCell
     
        Application.EnableEvents = True
    End If
End Sub

So this worked! Just need one minor tweak! When I select anything other than ***NAME NOT LISTED*** in Column D, N/A is populated in Column G as desired. However, if something from Column D is deleted or cleared, Column G rm

 

[Cubist]

How about this?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim changedCell As Range
    Dim intersectRange As Range

    ' Define the range of column D from D30 downwards
    Set intersectRange = Intersect(Target, Me.Range("D30:D" & Me.Rows.Count))

    If Not intersectRange Is Nothing Then
        Application.EnableEvents = False
        For Each changedCell In intersectRange
            If changedCell.Value = "" Then ' Check if the value is cleared out
                Me.Cells(changedCell.Row, "G").ClearContents ' Clear content in column G
            ElseIf changedCell.Value <> "***NAME NOT LISTED***" Then
                Me.Cells(changedCell.Row, "G").Value = "N/A"
            Else
                Me.Cells(changedCell.Row, "G").ClearContents
            End If
        Next changedCell
        Application.EnableEvents = True
    End If
End Sub