Appendix Thread. ( Codes for other Threads, etc.) Event Coding Drpdown Data validation

[DocAElstein]

Code for this post:
http://www.eileenslounge.com/viewtop...=31395#p242918

' Leave some lines free above
'  http://www.eileenslounge.com/viewtopic.php?f=30&t=31395#p242918

Sub WotchaGotInHorizontalClit() 'Examine what is copied to clipboard from a row, and paste it into code module
Rem 0 Test range
Range("A1:C1").Value = Array("A1", "B1", "C1")
Rem 1 Clitbored
Range("A1:C1").Copy
Dim objDataObject As Object '  DataObject Late Binding equivalent            ' http://excelmatters.com/2013/09/23/vba-references-and-early-binding-vs-late-binding/     http://www.excelfox.com/forum/showthread.php/2240-VBA-referring-to-external-shared-Libraries-1)-Early-1-5)-Laterly-Early-and-2)-Late-Binding-Techniques
 Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
 objDataObject.GetFromClipboard
Dim strIn As String: Let strIn = objDataObject.GetText() 'String of range as held in clitbored
Rem 2 examine string from clitbored
Dim myLenf As Long: Let myLenf = Len(strIn)
Dim cnt As Long
    For cnt = 1 To myLenf
    Dim Caracter As Variant ' String
     Let Caracter = Mid(strIn, cnt, 1)
    Dim WotchaGot As String
        If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then ' Check for normal characters
         Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
        Else
         Select Case Caracter
          Case " "
           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
          Case vbCr
           Let WotchaGot = WotchaGot & "vbCr & "
          Case vbLf
           Let WotchaGot = WotchaGot & "vbLf & "
          Case vbCrLf
           Let WotchaGot = WotchaGot & "vbCrLf & "
          Case """"
           Let WotchaGot = WotchaGot & """" & """" & """" & " & "
          Case vbTab
           Let WotchaGot = WotchaGot & "vbTab & "
          Case Else
           WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
           'Let CaseElse = Caracter
         End Select
        End If
    Next cnt
    If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3) ' take off last " & "
 MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot
Rem 4 paste into code module
 On Error Resume Next
 ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.AddFromString "Rem    " & strIn ' a Rem is added to stop the code module showing red error
 Set objDataObject = Nothing
End Sub

'
Sub WotchaGotInCodeWindowHorizontal() ' Examine first line of text in the code module
Rem 1 Put first line from code module into a string
Dim strVonCodMod As String
 Let strVonCodMod = ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.Lines(Startline:=1, Count:=1)
 Let strVonCodMod = Replace(strVonCodMod, "Rem    ", "", 1, -1, vbBinaryCompare)
Rem 2 examine string from code module line 1
Dim myLenf As Long: Let myLenf = Len(strVonCodMod)
Dim cnt As Long
    For cnt = 1 To myLenf
    Dim Caracter As Variant ' String
     Let Caracter = Mid(strVonCodMod, cnt, 1)
    Dim WotchaGot As String
        If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then
         Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
        Else
         Select Case Caracter
          Case " "
           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
          Case vbCr
           Let WotchaGot = WotchaGot & "vbCr & "
          Case vbLf
           Let WotchaGot = WotchaGot & "vbLf & "
          Case vbCrLf
           Let WotchaGot = WotchaGot & "vbCrLf & "
          Case """"
           Let WotchaGot = WotchaGot & """" & """" & """" & " & "
          Case vbTab
           Let WotchaGot = WotchaGot & "vbTab & "
          Case Else
           WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
           'Let CaseElse = Caracter
         End Select
        End If
    Next cnt
    If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3)
 MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot
Rem 3 clipbored
'3a Put string from first code module line in clipbored
Dim objDataObject As Object '
 Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
 objDataObject.SetText strVonCodMod
 objDataObject.PutInClipboard
 Set objDataObject = Nothing
'3b paste string from first code module line into worksheet
 Range("A1:C1").ClearContents
 Paste Destination:=Range("A1")
Rem 4 Delete first line from code module
 On Error Resume Next
 ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.DeleteLines Startline:=1, Count:=1
End Sub


'
Sub WotchaGotInVirticalClit() ''Examine what is copied to clipboard from a column, and paste it into code module
Rem 0 Test range
Dim WhoRay(1 To 3, 1 To 1) As String: Let WhoRay(1, 1) = "A1": Let WhoRay(2, 1) = "A2": Let WhoRay(3, 1) = "A3"
 Let Range("A1:A3").Value = WhoRay
Rem 1 Clipboard
 Range("A1:A3").Copy
Dim objDataObject As Object
 Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
 objDataObject.GetFromClipboard
Dim strIn As String: Let strIn = objDataObject.GetText()
Rem 2 Examine string held in clipboard from a copy from a column
Dim myLenf As Long: Let myLenf = Len(strIn)
Dim cnt As Long
    For cnt = 1 To myLenf
    Dim Caracter As Variant ' String
     Let Caracter = Mid(strIn, cnt, 1)
    Dim WotchaGot As String
        If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then
         Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
        Else
         Select Case Caracter
          Case " "
           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
          Case vbCr
           Let WotchaGot = WotchaGot & "vbCr & "
          Case vbLf
           Let WotchaGot = WotchaGot & "vbLf & "
          Case vbCrLf
           Let WotchaGot = WotchaGot & "vbCrLf & "
          Case """"
           Let WotchaGot = WotchaGot & """" & """" & """" & " & "
          Case vbTab
           Let WotchaGot = WotchaGot & "vbTab & "
          Case Else
           WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
           Let CaseElse = Caracter
         End Select
        End If
    Next cnt
    If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3)
 MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot
Rem 4 Paste stringt from clipboard into top of code module
 On Error Resume Next
 ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.AddFromString "Rem    " & Replace(strIn, vbLf, vbLf & "Rem    ", 1, 2, vbBinaryCompare)
 Set objDataObject = Nothing
End Sub

Sub WotchaGotInCodeWindowVertical() ' Examins what is held in a code module after pasting in a column froma worksheet
Rem 1 Put first 4 lines from code module into a string
Dim strVonCodMod As String
 Let strVonCodMod = ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.Lines(Startline:=1, Count:=4)
 Let strVonCodMod = Replace(strVonCodMod, "Rem    ", "", 1, -1, vbBinaryCompare)
Rem 2 Examine contents of string
Dim myLenf As Long: Let myLenf = Len(strVonCodMod)
Dim cnt As Long
    For cnt = 1 To myLenf
    Dim Caracter As Variant ' String
     Let Caracter = Mid(strVonCodMod, cnt, 1)
    Dim WotchaGot As String
        If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then
         Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
        Else
         Select Case Caracter
          Case " "
           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
          Case vbCr
           Let WotchaGot = WotchaGot & "vbCr & "
          Case vbLf
           Let WotchaGot = WotchaGot & "vbLf & "
          Case vbCrLf
           Let WotchaGot = WotchaGot & "vbCrLf & "
          Case """"
           Let WotchaGot = WotchaGot & """" & """" & """" & " & "
          Case vbTab
           Let WotchaGot = WotchaGot & "vbTab & "
          Case Else
           WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
           'Let CaseElse = Caracter
         End Select
        End If
    Next cnt
    If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3)
 MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot
Rem 3 Clipboard
'3a Put string into clipboard
Dim objDataObject As Object '
 Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
 objDataObject.SetText strVonCodMod
 objDataObject.PutInClipboard
 Set objDataObject = Nothing
'3b Paste into worksheet from clipboard
 Paste Destination:=Range("A1")
Rem 4 Delet first 4 rows from code module
 On Error Resume Next
 ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.DeleteLines Startline:=1, Count:=4
End Sub