Appendix-Thread-Evaluate-Range-(-Codes-for-other-Threads-HTML-Tables-etc-)

[DocAElstein]

In support of this forum post
https://eileenslounge.com/viewtopic.php?f=30&t=38895

This is Hans final working Solution

 '    Hans   https://eileenslounge.com/viewtopic.php?p=300746#p300746
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Pee As String
On Error GoTo Myerror
 Let Application.EnableEvents = False
'    If Not Intersect(Target, Columns(1)) Is Nothing Then
        For Each Rng In Intersect(Target, Columns(1))
         Let Pee = Replace(Replace(Evaluate("Proper(""" & Rng.Value & """)"), " ", ""), "-", "")
            Select Case Pee
                Case "A"
                 Let Rng.Value = "ABC"
                Case "Aa"
                 Let Rng.Value = "XXD"
                Case Else
                 Rng.ClearContents
            End Select
        Next Rng
'    End If
Myerror:
 Let Application.EnableEvents = True
End Sub

---

We can pretty this via Evaluate Range up in two main ways
_ The VBA Replace ideas can be replaced in the Evaluate by Excel spreadsheet SUBSTITUTE
_ The VBA Select Case ideas can be replaced by the Excel spreadsheet IF

The full coding example here follows approximately the Excel spreadsheet workings in the uploaded file. (In that file my workings are for the example range D11:D12 being copied and pasted into column 1, range A11:A12)
Note that in some steps the trick IF({1},___) was needed to get more than one result, but it was often found that in subsequent steps this could be removed. I expect this is because whatever phenomena is going on in that trick, goes on when we introduce steps involving IFs on multi cell ranges, so then the trick is redundant.

Private Sub Worksheet_Change(ByVal Target As Range)  '   https://excelfox.com/forum/showthread.php/2834-Appendix-Thread-Evaluate-Range-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=19028&viewfull=1#post19028
Dim Pee As String '  , Rng As Range
On Error GoTo Myerror
 Let Application.EnableEvents = False
    If Not Intersect(Target, Columns(1)) Is Nothing Then
    Dim varTest As Variant
     Let varTest = Evaluate("=IF({1},PROPER(" & Target.Address & "))")
     Let varTest = Evaluate("=IF({1},SUBSTITUTE(IF({1},PROPER(" & Target.Address & ")),"" "",""""))")
     Let varTest = Evaluate("=IF({1},SUBSTITUTE(PROPER(" & Target.Address & "),"" "",""""))")
     Let varTest = Evaluate("=IF({1},SUBSTITUTE(SUBSTITUTE(PROPER(" & Target.Address & "),"" "",""""),""-"",""""))")
     Let varTest = Evaluate("=IF(IF({1},SUBSTITUTE(SUBSTITUTE(PROPER(" & Target.Address & "),"" "",""""),""-"",""""))=""A"",""ABC"",""x"")")
     Let varTest = Evaluate("=IF(SUBSTITUTE(SUBSTITUTE(PROPER(" & Target.Address & "),"" "",""""),""-"","""")=""A"",""ABC"",""x"")")
     Let varTest = Evaluate("=IF(SUBSTITUTE(SUBSTITUTE(PROPER(" & Target.Address & "),"" "",""""),""-"","""")=""A"",""ABC"",IF(SUBSTITUTE(SUBSTITUTE(PROPER(" & Target.Address & "),"" "",""""),""-"","""")=""Aa"",""XXD"",""""))")
     'Let Target.Value2 = varTest
     Let Target.Value2 = Evaluate("=IF(SUBSTITUTE(SUBSTITUTE(PROPER(" & Target.Address & "),"" "",""""),""-"","""")=""A"",""ABC"",IF(SUBSTITUTE(SUBSTITUTE(PROPER(" & Target.Address & "),"" "",""""),""-"","""")=""Aa"",""XXD"",""""))")
'        For Each Rng In Intersect(Target, Columns(1))
'         Let Pee = Replace(Replace(Evaluate("Proper(""" & Rng.Value & """)"), " ", ""), "-", "")
'            Select Case Pee
'                Case "A"
'                 Let Rng.Value = "ABC"
'                Case "Aa"
'                 Let Rng.Value = "XXD"
'                Case Else
'                 Rng.ClearContents
'            End Select
'        Next Rng
    Else
    ' case not pasted in column 1
    End If
Myerror:
 Let Application.EnableEvents = True
End Sub