Macro not restoring numeric value if letter value blank

[Ochimus]

Sure someone has a much simpler solution to this challenge from grandson to "automate" a process where numeric values in a Crossword have to be replaced by letters.

Worksheet has two Numeric Crosswords in rows 2 - 14, with the Matrix matching numeric to alphabetic values in rows 17 - 22. Original Numeric version is in rows 27 - 39 so the Code can "copy back" the Numeric value if a letter is deleted in the Matrix.

Codes replace a value in the Crossword if a letter is entered in the "Matrix" rows, but can't get it reverse the process, so that clearing a letter in the Matrix restores the numeric value.

1. Worksheet Change Macro ensures process starts only if any letters are added, changed or deleted in any of the four Matrices:

Option Explicit
Dim x As String, y As String
Dim cell As Range, cell2 As Range, MASTER1 As Range, MASTER2 As Range, SET1 As Range, SET2 As Range, SET3 As Range, SET4 As Range, XWORD1 As Range, XWORD2 As Range

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False 'to prevent endless loop
    On Error GoTo FINALIZE 'to re-enable the events
    
    Set XWORD1 = Range("B2:N14")
    Set MASTER1 = Range("B27:N39")
    Set SET1 = Range("B18:N18")
    Set SET2 = Range("B21:N21")
    
    Set XWORD2 = Range("T2:AF14")
    Set MASTER2 = Range("T27:AF39")
    Set SET3 = Range("T18:AF18")
    Set SET4 = Range("T21:AF21")

'Run Macro only if letters added or deleted from LISTINGS

    If Not Intersect(ActiveCell.Offset(-1, 0), SET1) Is Nothing Then
    EXCHANGE
    
    ElseIf Not Intersect(ActiveCell.Offset(-1, 0), SET2) Is Nothing Then
    EXCHANGE
    
    ElseIf Not Intersect(ActiveCell.Offset(-1, 0), SET3) Is Nothing Then
    EXCHANGE

    ElseIf Not Intersect(ActiveCell.Offset(-1, 0), SET4) Is Nothing Then
    EXCHANGE

    End If
    
    Application.EnableEvents = True
    
FINALIZE:

    Application.EnableEvents = True
    
End Sub

Second Macro should then replace the numbers with whatever letter you enter, AND restore the number if there is no letter in the Matrix:

Option Explicit
Dim x As String, y As String
Dim cell As Range, cell2 As Range, MASTER1 As Range, MASTER2 As Range, SET1 As Range, SET2 As Range, SET3 As Range, SET4 As Range, XWORD1 As Range, XWORD2 As Range

Sub EXCHANGE()


    Application.EnableEvents = False 'to prevent endless loop
    On Error GoTo FINALIZE 'to re-enable the events
    
    Set XWORD1 = Range("B2:N14")
    Set MASTER1 = Range("B27:N39")
    Set SET1 = Range("B18:N18")
    Set SET2 = Range("B21:N21")
    
    Set XWORD2 = Range("T2:AF14")
    Set MASTER2 = Range("T27:AF39")
    Set SET3 = Range("T18:AF18")
    Set SET4 = Range("T21:AF21")


'Run Macro only if letters added or deleted from LISTINGS

    If Not Intersect(ActiveCell.Offset(-1, 0), SET1) Is Nothing Then
    
'Set letter and Number values for the changed cell
    
    x = ActiveCell.Offset(-1, 0).Value
    y = ActiveCell.Offset(-2, 0).Value
  
'Loop through all cells in the MASTER1 Crossword
        
        For Each cell2 In MASTER1

'If cell value matches, check matching cell in actual Crossword

            If cell2 = y Then
                
'If the crossword cell does not match the Letter replace it with the Letter value

                If cell2.Offset(-25, 0) <> x Then
                cell2.Offset(-25, 0) = x
                End If
                
'If the letter value is blank, replace it with the Number value
                
                If cell2.Offset(-25, 0) = "" Then
                cell2.Offset(-25, 0) = y
                End If

            End If
            
        Next
    
    ElseIf Not Intersect(ActiveCell, SET2) Is Nothing Then
    
        x = ActiveCell.Offset(-1, 0).Value
        y = ActiveCell.Offset(-2, 0).Value
        
        For Each cell2 In MASTER1
            If cell2 = y Then
                If cell2.Offset(-25, 0) <> x Then
                    If x = "" Then
                    cell2.Offset(-25, 0) = y
                    Else: cell2.Offset(-25, 0) = x
                    End If
                End If
            End If
            
        Next
    
    
    ElseIf Not Intersect(ActiveCell, SET3) Is Nothing Then
    
        x = ActiveCell.Offset(-1, 0).Value
        y = ActiveCell.Offset(-2, 0).Value
    
        
        For Each cell2 In MASTER2
            If cell2 = y Then
                If cell2.Offset(-25, 0) <> x Then
                    If x = "" Then
                    cell2.Offset(-25, 0) = y
                    Else: cell2.Offset(-25, 0) = x
                    End If
                End If
            End If
            
        Next
    
    ElseIf Not Intersect(ActiveCell, SET4) Is Nothing Then
    
        x = ActiveCell.Offset(-1, 0).Value
        y = ActiveCell.Offset(-2, 0).Value
    
        
        For Each cell2 In MASTER2
            If cell2 = y Then
                If cell2.Offset(-25, 0) <> x Then
                    If x = "" Then
                    cell2.Offset(-25, 0) = y
                    Else: cell2.Offset(-25, 0) = x
                    End If
                End If
            End If
            
        Next
    
    End If
        
    Application.EnableEvents = True
    
FINALIZE:
    Application.EnableEvents = True
    
End Sub

All solutions, suggestions and improvements welcome as ever.

Ochimus