Appendix Thread 2. ( Codes for other Threads, HTML Tables, etc.)

[DocAElstein]

Routine for following excelfox Thread
http://www.excelfox.com/forum/showth...0864#post10864 .....

Sub PubProliferous_Get_Rng__AsString() ' This pastes out all held table range values in this code module
Rem 0 VBA project instantiated VBIDE
Dim VBIDEVBAProj As Object ' For convenience a variable is used for this code module
 Set VBIDEVBAProj = ThisWorkbook.VBProject.VBE.ActiveCodePane.codemodule                                                 ' ThisWorkbook.VBProject.VBComponents(Me.CodeName) 'varible referring to this code module
Rem 1 Do it all
    Do: Dim EndOFSub As Boolean ' looping while not at End Sub =================================
        Do: Dim FOB As Boolean ' looping while in range data ------------------------------
        Dim ReedLineIn As String
            If ReedLineIn = "" Then ' because there is no code line in the next line we will go to  Let ReedLineIn =     if the condition "" is met
            'for an empty line we do nothing apart from having already deleted it ( for all but the first time here at the code start)
            Else ' We are in data or start or stop-----------------|
            Dim arrOut As String ' A string for output from clipboard for each found range
                If Mid(ReedLineIn, 15, 12) = "Worksheets(""" Then ' we are at backward looping end(start) of data
                 Let ReedLineIn = Replace(Replace(Mid(ReedLineIn, 27), """).Range(""", " "), """)", "") 'Let ReedLineIn = Mid(ReedLineIn, 27): ReedLineIn = Replace(ReedLineIn, """).Range(""", " ", 1, 1, vbBinaryCompare): ReedLineIn = Replace(ReedLineIn, """)", "", 1, 1, vbBinaryCompare)
                 'MsgBox ReedLineIn: Debug.Print ReedLineIn ' ' This is particularly useful in developing codes of this nature, as usally step  (F8)  mode will often fail due to code lines referrencig this code module  which trip up the process somehow
                Dim Ws As Worksheet, Rng As Range 'variables to use for output range details
                 Set Ws = Worksheets(Split(ReedLineIn)(0)): Set Rng = Ws.Range(Split(ReedLineIn)(1)) ' The returned array from spliting by the space , " " ,  will have first element (indicie(0)) of like  "Sheet1"  and the second element (indicie(1))  of like  "$B$1:$D$13"
                ' Section to prepare data for, and to do, the paste out of a data value range                                                                                                     Output preparing section !!
                 'MsgBox arrOut: Debug.Print arrOut
                 Let arrOut = Replace(Replace(arrOut, "'_-", ""), " | ", vbTab) ' The "inner" Replace takes out the "'_-" bit at the start of a line, and the "outer" Replace changes the seperator used in the code module  " | "    for that which appears to be used by Excel to determine a cell "wall"  vbTab
                 'MsgBox arrOut: Debug.Print arrOut
                 Let arrOut = Replace(arrOut, "  ", "", 1, -1, vbBinaryCompare) ' this is intended as a partial solution to removing most of the extra spaces that we added, whilst not removing any intentionally there. You may want to adjust this along with the actual character used to fill in the unused spaces in oder to come up with a better solution to suit specific data types
                 'MsgBox arrOut: Debug.Print arrOut     'WotchaGot (arrOut) ' routine to examine contents of string
                Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): objDataObject.SetText arrOut: objDataObject.PutInClipboard ' Text is given to Data object which in turn uses its method to put that in the clipboard
                 Ws.Paste Destination:=Rng 'Worksheets Paste method with optional argument to determine where, ( default would be from top left of active range )
                 Let arrOut = "" ' Clear the string to allow for collection of next range
                    If Right(VBIDEVBAProj.Name, 4) = "_txt" Then Let VBIDEVBAProj.Name = Replace(VBIDEVBAProj.Name, "_txt", "", 1, 1, vbBinaryCompare)
                Else
                ' Section to collect the range value data ( If not at the end section of a data range held in the code window like  '_- EOF 22 12 2018 )
                    If Left(ReedLineIn, 8) = "'_- EOF " Then '
                    ' Let FOB = True ' Let FOB = True is not needed, as clearing the string arrOut effectively starts us again afresh
                    'for last data we do nothing apart from having already deleted it
                    Else ' from here we are in data collecting/concatanating into string arrOut +++++
                     Let arrOut = ReedLineIn & vbCr & vbLf & arrOut   ' A simple concatenation along with a new line indicator will give a convenient format of the final data range for use in the Output preparing section !! above  Note: we build the string "bachwards" with the next line as first and previous lies after it because the code is looping backwards
                    End If ' we were collecting/concatenating range value data                  +++++
                End If
            End If ' we are did stuff in data or start or stop-----|
        Let ReedLineIn = VBIDEVBAProj.Lines(StartLine:=VBIDEVBAProj.countoflines, Count:=1)
            If ReedLineIn = "End Sub" Or ReedLineIn = "End Function" Then
             Let EndOFSub = True
            Else ' after reading in any line, we delete it, unless it was the End of a routine
             VBIDEVBAProj.DeleteLines StartLine:=VBIDEVBAProj.countoflines, Count:=1
            End If
        Loop While Not EndOFSub = True ' And FOB = False '------------------------------------
     'MsgBox Prompt:="In between data ranges": Let FOB = False ' we could do something here to tell us we are in between range, such as count the ranges, and then set FOB back to zero
    Loop While EndOFSub = False ' ================================================================
End Sub