Repeating formula in VBA

[adam234432]

I got this code off another user on here. It allows me to create greyed out text from a template sheet. However, when you write in it the cell the text is removed and the new text becomes black. Then once deleted it goes back to the original grey text. I need to repeat this for multiple areas and I cant get it to work. e.g E8:E194. I am very new to using excel and this is my first time using VBA. So would appreciate any assistance. Thanks.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Colr As Long, Txt As String

If Target.Count = 1 Then
If Not Intersect(Target, Range("D8:D194")) Is Nothing Then
Txt = Sheets("CodeTemplate").Range(Target.Address).Value
End If

Application.EnableEvents = False
If Len(Target.Value) = 0 Or Target.Value = Txt Then
Target.Font.ColorIndex = 16
Target.Value = Txt
Else
Target.Font.ColorIndex = 1
End If
Application.EnableEvents = True
End If

End Sub

 

[StephenCrump]

Welcome to the Forum!

A bit of a guess, but is this what you're looking for?

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Colr As Long
    Dim Txt As String
    Dim rng As Range, r As Range
      
    Set rng = Intersect(Target, Range("D8:E194"))
    If Not rng Is Nothing Then
        Application.EnableEvents = False
        For Each r In rng
            Txt = Worksheets("CodeTemplate").Range(Target.Address).Value
            If Len(Target.Value) = 0 Or Target.Value = Txt Then
                Target.Font.ColorIndex = 16
                Target.Value = Txt
            Else
                Target.Font.ColorIndex = 1
            End If
        Next r
        Application.EnableEvents = True
    End If
    
End Sub

Note that string comparisons such as Target.Value = Txt are case sensitive.

If you don't want case-sensitive, you can add the line: Option Compare Text to the top of the module.

 

[rlv01]

Possibly something like this.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Colr As Long, Txt As String
    Dim R1 As Range, R2 As Range, R3 As Range

    If Target.Count = 1 Then
        Set R1 = Range("D8:D194")                     'range 1 of 3
        Set R2 = Range("E8:E194")                     'range 2 of 3
        Set R3 = Range("N8:N194")                     'range 3 of 3

        If Not Intersect(Target, Union(R1, R2, R3)) Is Nothing Then
            Txt = Sheets("CodeTemplate").Range(Target.Address).Value
        End If

        Application.EnableEvents = False
        If Len(Target.Value) = 0 Or Target.Value = Txt Then
            Target.Font.ColorIndex = 16
            Target.Value = Txt
        Else
            Target.Font.ColorIndex = 1
        End If
        Application.EnableEvents = True
    End If
End Sub

 

[adam234432]

T

Welcome to the Forum!

A bit of a guess, but is this what you're looking for?

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Colr As Long
    Dim Txt As String
    Dim rng As Range, r As Range
     
    Set rng = Intersect(Target, Range("D8:E194"))
    If Not rng Is Nothing Then
        Application.EnableEvents = False
        For Each r In rng
            Txt = Worksheets("CodeTemplate").Range(Target.Address).Value
            If Len(Target.Value) = 0 Or Target.Value = Txt Then
                Target.Font.ColorIndex = 16
                Target.Value = Txt
            Else
                Target.Font.ColorIndex = 1
            End If
        Next r
        Application.EnableEvents = True
    End If
   
End Sub

Note that string comparisons such as Target.Value = Txt are case sensitive.

If you don't want case-sensitive, you can add the line: Option Compare Text to the top of the module.

Thank you

 

[adam234432]

Possibly something like this.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Colr As Long, Txt As String
    Dim R1 As Range, R2 As Range, R3 As Range

    If Target.Count = 1 Then
        Set R1 = Range("D8:D194")                     'range 1 of 3
        Set R2 = Range("E8:E194")                     'range 2 of 3
        Set R3 = Range("N8:N194")                     'range 3 of 3

        If Not Intersect(Target, Union(R1, R2, R3)) Is Nothing Then
            Txt = Sheets("CodeTemplate").Range(Target.Address).Value
        End If

        Application.EnableEvents = False
        If Len(Target.Value) = 0 Or Target.Value = Txt Then
            Target.Font.ColorIndex = 16
            Target.Value = Txt
        Else
            Target.Font.ColorIndex = 1
        End If
        Application.EnableEvents = True
    End If
End Sub

This worked perfectly. I appreciate your time.