Sub Checker()
'
Dim cSht1 As String, cSht2 As String, cRng0 As String, cRng1 As String, cRng2 As String, lOldName As Long, lNewName As Long, lChange As Long
Dim cLastName1 As String, cFirstName1 As String, cLastName2 As String, cFirstName2 As String, fOK As Boolean
 
   cSht1 = "Sheet2!"
   cSht2 = "AddressChange!"
   lNewName = 2
 
   For lOldName = 2 To [NameCount]
      Application.StatusBar = "Processing Name #" & lOldName - 1 & " out of " & [NameCount] - 1 & ": " & lChange - 1 & " address changes found"
      cRng1 = CellName(cSht1 & "A", lOldName)
      cLastName1 = Range(cRng1).Value
      cRng1 = CellName(cSht1 & "B", lOldName)
      cFirstName1 = Range(cRng1).Value
      fOK = False
      Do
         cRng1 = CellName(cSht1 & "D", lNewName)
         cLastName2 = Range(cRng1).Value
         If cLastName1 = cLastName2 Then
            cRng1 = CellName(cSht1 & "E", lNewName)
            cFirstName2 = Range(cRng1).Value
            If cFirstName1 = cFirstName2 Then fOK = True
         End If
         If Not fOK Then lNewName = lNewName + 1
      Loop Until fOK
      cRng1 = CellName(cSht1 & "C", lOldName)
      cRng1 = Range(cRng1).Value
      cRng2 = CellName(cSht1 & "F", lNewName)
      cRng2 = Range(cRng2).Value
      If cRng1 <> cRng2 Then
         cRng0 = CellName(cSht2 & "A", [ChangeCount] + 1)
         Range(cRng0).Value = cLastName1
         cRng0 = CellName(cSht2 & "B", [ChangeCount])
         Range(cRng0).Value = cFirstName1
         cRng0 = CellName(cSht2 & "C", [ChangeCount])
         Range(cRng0).Value = cRng1
         cRng0 = CellName(cSht2 & "D", [ChangeCount])
         Range(cRng0).Value = cRng2
      End If
   Next
   Application.StatusBar = False
 
End Sub