Adjust code to account for variable entry

[Drawleeh]

Hello, I have code that essentially will fill the address of a row when something is filled within column C, D and E. However currently it only works when either: something is copied into all 3 column cells adjacent to each other at the same time i.e information is copied into C3 D3 and E3 OR when information is entered into E3 then entered into D3 and then into C3.

The issue is, is that it doesn't produce the row address when those 3 adjacent fields are filled in any other way. Is there any way to adjust the following code to account for when there is something in all 3 cells of the 3 columns regardless of how that information is entered in which order?

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo ClearError
    
    Const fRow As Long = 2
    Const sCol As String = "C"
    Const bCols As String = "C:E"
    Const dCol As String = "A"
     
    Dim crg As Range
    Set crg = Columns(sCol).Resize(Rows.Count - fRow + 1).Offset(fRow - 1)
    Debug.Print "crg: " & crg.Address(0, 0)
    Dim irg As Range: Set irg = Intersect(crg, Target)
    If irg Is Nothing Then Exit Sub

    Dim brg As Range: Set brg = Columns(bCols)
    Dim srg As Range: Set srg = Intersect(irg.EntireRow, brg)
    
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim arg As Range
    Dim rrg As Range
    Dim RowString As String
    
    For Each arg In srg.Areas
        For Each rrg In arg.Rows
            
            If Application.CountBlank(rrg) = 0 Then
                RowString = CStr(rrg.Row)
                RowString = "'" & RowString & ":" & RowString
                rrg.EntireRow.Columns(dCol).Value = RowString
            End If
        Next rrg
    Next arg

SafeExit:
     
    If Not Application.EnableEvents Then
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
    
    Exit Sub

ClearError:
    Debug.Print "Run-time error '" & Err.Number & "':" & Err.Description
    Resume SafeExit
End Sub

 

[Jeffrey Mahoney]

Try this

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim crg As Range
    Dim irg As Range
    Dim brg As Range
    Dim srg As Range
    
    Const fRow As Long = 2
    Const sCol As String = "C"
    Const bCols As String = "C:E"
    Const dCol As String = "A"
    
     
    'Set crg = Columns(sCol).Resize(Rows.Count - fRow + 1).Offset(fRow - 1)
    Set crg = Range(Range(sCol & fRow), Cells(Cells.Rows.Count, 5))
    'Debug.Print "crg: " & crg.Address(0, 0)
    Set irg = Intersect(crg, Target)
    If irg Is Nothing Then Exit Sub
    Set srg = Intersect(Target.EntireRow, crg)
    
    If Application.CountA(srg) = 3 Then
      Application.EnableEvents = False
      Set brg = Intersect(Columns(dCol), Target.EntireRow)
      brg.NumberFormat = "@"
      brg.Value = Target.EntireRow.Address(0, 0)
      Application.EnableEvents = True
    End If
    
    
End Sub