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

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

Code:

---

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

---

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg. 9bbxud383FI9c-vOQApTgb
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg. 9bbxud383FI9c-vbihZ-7W
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg. 9bbxud383FI9c-vfmpSO0F
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg. 9bbxud383FI9c-vjfTJ7lX
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg. 9bbxud383FI9c-vmq-LHHz
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg. 9bbxud383FI9c-vst3j_7i
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg. 9bbxud383FI9bwBqjIR5Nj
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg. 9bbxud383FI9bwBw8El0r5
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg. 9bbxud383FI9bwC63GbRuM
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg. 9bbxud383FI9bwC9fyKZdo
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg. 9bbxud383FI9bwCEn8DBQe
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg. 9bbxud383FI9bw0Bey8gQO
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

Routine for following excelfox Thread
http://www.excelfox.com/forum/showth...0865#post10865

Code:

---

Sub TestieCall()
 Call PubeProFannyTeas__GLetner("23 12 2018")
End Sub
Sub PubeProFannyTeas__GLetner(ByVal strDte As String)
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 This code module data range
'1a) get full data range as string
Dim Cnt As Long, Lr As Long, ReedLineIn As String
 Let Lr = VBIDEVBAProj.countoflines: Let Cnt = Lr + 1
    Do
    Let Cnt = Cnt - 1
    Let ReedLineIn = VBIDEVBAProj.Lines(StartLine:=Cnt, Count:=1)
    Loop While Not (Left(ReedLineIn, 7) = "End Sub" Or Left(ReedLineIn, 7) = "End Fun")
    If Cnt = Lr Then MsgBox Prompt:="No range data values in code module  " & VBIDEVBAProj.Name: Exit Sub
'1b) Complete data region as single string.
Dim strIn As String: Let strIn = VBIDEVBAProj.Lines(StartLine:=Cnt + 1, Count:=Lr - Cnt)
 Let strIn = Mid(strIn, 3) ' take off first vbCr & vbLf
 'WotchaGot (strIn)
'1c) split into date ranges, get most recent of any dates to match given  strDte
Dim DtedRngs() As String: Let DtedRngs() = Split(strIn, vbCr & vbLf & vbCr & vbLf) ' Split range by empty line which is double  vbCr & vbLf
 'WotchaGot (DtedRngs(0)): Debug.Print: WotchaGot (DtedRngs(1))
    For Cnt = UBound(DtedRngs()) To LBound(DtedRngs()) Step -1
    '1d)Check for date match, if so the main code working begins
        Dim FndDte As String: Let FndDte = Mid(DtedRngs(Cnt), 4, 10) ' looking at like this typical start of a data range,    '_-23 12 2018 Wo....  we see that 10 characters from character 4 will give us the date
        If FndDte = strDte Then
        'MsgBox Prompt:=FndDte
        Rem 2 manipulation of found date range
        Dim strRng As String: Let strRng = DtedRngs(Cnt)
        Let strRng = Mid(strRng, 27) 'takes off up to start of worksheet name... no speacial reason toher than why not? - its not needed anymore
        '2a) range info
        Dim RngInfo As String: Let RngInfo = Left(strRng, InStr(1, strRng, """)" & vbCr & vbLf, vbBinaryCompare) - 1) '    This gets us at like        Tabelle1").Range("$I$2513:$J$2514
        Dim ShtName As String, RngAdrs As String
        Let ShtName = Split(RngInfo, """).Range(""", 2, vbBinaryCompare)(0) '    split above string ,  using as seperator  ").Range("  ,  into 2 bits  ,  for exact computer binary type compare    Then we have first array element (indicie (0)) as the worksheet name  and the second array element (indicie (1)) as the range address
        Let RngAdrs = Split(RngInfo, """).Range(""", 2, vbBinaryCompare)(1) ': Debug.Print ShtName & "  " & RngAdrs
        Dim Ws As Worksheet, Rng As Range: Set Ws = Worksheets("" & ShtName & ""): Set Rng = Ws.Range(RngAdrs)
        '2b) get data value range
        Let strRng = Mid(strRng, InStr(1, strRng, vbCr & vbLf, vbBinaryCompare) + 2) ' take off first line & the first vbCr & vbLf
        Let strRng = Left(strRng, InStr(1, strRng, "'_- EOF ", vbBinaryCompare) - 1) ' take off last line, ( but leave on the vbCr & vbLf as that seems to typically be on a string from an excel range
        'WotchaGot strRng
        Let strRng = Replace(strRng, " | ", vbTab, 1, -1, vbBinaryCompare) 'Change code window cell wall seperator for that used by Excel
        Let strRng = Replace(strRng, "'_-", "", 1, -1, vbBinaryCompare)
        Let strRng = Replace(strRng, "  ", "", 1, -1, vbBinaryCompare) ' Bit of bodge to remove my added spaces
        'Debug.Print strRng
        Rem 3 output to worksheet
        Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): objDataObject.SetText strRng: 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 )
        Exit Sub 'This code only gets the first found range looking from code window bottom
        Else '    No matching date found yet, so do nothing but
        End If '    go on to
    Next Cnt '    next date range ' ( There is no check for no matching date. The code will simple end after all ranges have been looped through.)
End Sub

---

Code for Yassser here:
http://www.eileenslounge.com/viewtop...=31529#p243999

Code:

---

Option Explicit
'I have numbers from 1 to 2319 made in groups in different numbers (in ten groups) as shown in column F
'How can I get random distribution for those group to have the same range of numbers from 1 to 2319
'but in different order and at the same time to have the same number inside each group
'Example
'Group 6 from 1267 - 1489 >> the number inside that group is 223
'Suppose the random choice make this group the first one so the expected result would be 1 - 223
'
'then suppose the second selected group is group 8 which is 1699 - 1938 >> the number inside that group is 240
'So that new group in the expected result would start at 224
'(which is the last number in the previous result and the finish number would be 463
'
'...
'Is it possible to do that in random order?
'
Sub RandomDistribution4Numbers() ' http://www.eileenslounge.com/viewtopic.php?f=30&t=31529
Dim Ws1 As Worksheet: Set Ws1 = Worksheets("Sheet1")
Dim arrSN() As Variant: Let arrSN() = Ws1.Range("F2:F" & Ws1.Range("F" & Rows.Count & "").End(xlUp).Row & "").Value ' range of current SNs
Dim LstGrpStp As Long: Let LstGrpStp = 0 ' last number used at end of random number group
Dim arrGrpsOut() As String: ReDim arrGrpsOut(1 To UBound(arrSN(), 1), 1 To 1) ' Array for output values
    Do ' we loop while we have not yet filled all of the output array, arrGrpsOut()
    Dim Rnd1ToUBnd As Long ' For a random array indicie from 1 to the UBound "row" of the input, (and output), arraysd
    Randomize: Let Rnd1ToUBnd = Int(UBound(arrSN(), 1) * Rnd) + 1
        If arrGrpsOut(Rnd1ToUBnd, 1) = "" Then ' Not yet filled this element in output array, so do the main stuff
        Dim OutElsFilled As Long: Let OutElsFilled = OutElsFilled + 1 ' count of number of outup array elements filled
        ' split F column (arrSN())  numbers to get range of numbers
        Dim SpltRng() As String: Let SpltRng() = Split(arrSN(Rnd1ToUBnd, 1), " - ", 2, vbBinaryCompare)
        Dim Rng As Long: Let Rng = SpltRng(1) - SpltRng(0) ' Range of numbers
        Dim Stt As Long, Stp As Long: Let Stt = LstGrpStp + 1: Let Stp = LstGrpStp + Rng + 1 ' Start and stop of range of numbers
        ' build output array with the numbers
        Let arrGrpsOut(Rnd1ToUBnd, 1) = Stt & " - " & Stp
        Let LstGrpStp = Stp ' Last highest used number
        Else ' If we come here then our random number must of been for an indicie of an array element already filled - so this probably makes the code a bit inefficient
        End If
    Loop While OutElsFilled < UBound(arrSN(), 1) ' we loop while we have not yet filled all of the output array, arrGrpsOut(), which is determined by if we did the main stuff as many times as there are elements in the input/Output arrays

 Let Ws1.Range("G2").Resize(UBound(arrSN(), 1)).Value = arrGrpsOut
End Sub
'





Sub RandomizeGroups() ' Hans code ' http://www.eileenslounge.com/viewtopic.php?f=30&t=31529#p244006
    Dim arr  As Variant
    Dim lb    As Long
    Dim ub    As Long
    Dim i    As Long
    Dim j    As Long
    Dim tmp  As Long
    Dim n    As Long
    Dim idx() As Long
    Dim itm() As String
    Dim grp() As String
    arr = Range("F2:F11").Value
    lb = LBound(arr, 1)
    ub = UBound(arr, 1)
    ReDim idx(lb To ub)
    ReDim grp(lb To ub)
    For i = lb To ub
        idx(i) = i
    Next i
    For i = lb To ub
        j = Application.RandBetween(lb, ub)
        tmp = idx(i)
        idx(i) = idx(j)
        idx(j) = tmp
    Next i
    n = 1
    For i = lb To ub
        itm = Split(arr(idx(i), 1), " - ")
        grp(idx(i)) = n & " - " & n + itm(1) - itm(0)
        n = n + itm(1) - itm(0) + 1
    Next i
    Range("G2:G11").Value = Application.Transpose(grp)
End Sub

---

Typical results from my code are shown in column G. ( The code works on the data from column F )

_____ Workbook: Sample.xlsm ( Using Excel 2007 32 bit )

Row\Col	E	F	G	H	I
1	for illustration	SN		Some expected result	Number inside Group
2	1	1 - 244	923 - 1166		244
3	2	245 - 448	1 - 204		204
4	3	449 - 750	398 - 699		302
5	4	751 - 1003	1879 - 2131		253
6	5	1004 - 1266	1167 - 1429		263
7	6	1267 - 1489	700 - 922	1 - 223	223
8	7	1490 - 1698	1430 - 1638		209
9	8	1699 - 1938	1639 - 1878	224 - 463	240
10	9	1939 - 2126	2132 - 2319		188
11	10	2127 - 2319	205 - 397		193

Worksheet: Sheet1


here below a few more runs, showing just column G
_____ Workbook: Sample.xlsm ( Using Excel 2007 32 bit )

Row\Col	G
1
2	591 - 834
3	835 - 1038
4	1502 - 1803
5	2067 - 2319
6	1804 - 2066
7	1279 - 1501
8	382 - 590
9	1039 - 1278
10	194 - 381
11	1 - 193

Worksheet: Sheet1

_____ Workbook: Sample.xlsm ( Using Excel 2007 32 bit )

254 - 497	2076 - 2319	1470 - 1713	638 - 881
498 - 701	517 - 720	1923 - 2126	1 - 204
1174 - 1475	1774 - 2075	705 - 1006	2018 - 2319
1 - 253	264 - 516	264 - 516	1354 - 1606
911 - 1173	1 - 263	1 - 263	882 - 1144
1476 - 1698	1551 - 1773	1247 - 1469	1607 - 1829
702 - 910	1342 - 1550	1714 - 1922	1145 - 1353
1892 - 2131	721 - 960	1007 - 1246	205 - 444
2132 - 2319	1154 - 1341	517 - 704	1830 - 2017
1699 - 1891	961 - 1153	2127 - 2319	445 - 637

Worksheet: Sheet1

Code:

---

'

Sub Populatenumbersfromrangeofnumbers2() ' http://www.eileenslounge.com/viewtopic.php?f=30&t=31531&p=244015#p244015
Dim Ws1 As Worksheet: Set Ws1 = Worksheets("Sheet1")
Dim arrSN() As Variant: Let arrSN() = Ws1.Range("F2:F" & Ws1.Range("F" & Rows.Count & "").End(xlUp).Row & "").Value ' range of current SNs
Dim arrGrpsOut() As String: ReDim arrGrpsOut(1 To 1) ' 1 Dimensional  Array for output values.
Dim cnt As Long, Cnt2 As Long, Rng2 As Long, Rng1 As Long, Rws As Long
    For cnt = LBound(arrSN(), 1) To UBound(arrSN(), 1)
    Dim SpltRng() As String: Let SpltRng() = Split(arrSN(cnt, 1), " - ", 2, vbBinaryCompare)
    Dim arrRws() As Variant 'Array for 1 2 3 4 5 6 7 etc
    Let arrRws() = Evaluate("=row(" & SpltRng(0) & ":" & SpltRng(1) & ")") ' This returns a one "column" 2 Dimensional array of all the numbers between the ranges
    Let Rng1 = UBound(arrGrpsOut()) + 1 ' The start of a range must be just above the last one
    Let Rng2 = Rng1 + SpltRng(1) - SpltRng(0) ' 'this gives the top of the current range in indicies of arrGrpsOut()
    ReDim Preserve arrGrpsOut(1 To Rng2)
        For Cnt2 = Rng1 To Rng2
        Let arrGrpsOut(Cnt2) = arrRws(Cnt2 - Rng1 + 1, 1) ' Cnt2 is the indicie in arrGrpsOut(), for the indicie in arrRws() we need to start at 1, then 2 3 4 5
        Next Cnt2
    Next cnt

Dim arrOut() As String: ReDim arrOut(1 To UBound(arrGrpsOut()) - 1, 1 To 1) ' a 2 dimension, 1 column , to be easy to post the results of this array into a column
    For cnt = 1 To UBound(arrGrpsOut()) - 1
    Let arrOut(cnt, 1) = arrGrpsOut(cnt + 1)
    Next cnt

 Let Ws1.Range("K2").Resize(UBound(arrOut(), 1), 1) = arrOut()
End Sub
Sub Populatenumbersfromrangeofnumbers2_2() ' http://www.eileenslounge.com/viewtopic.php?f=30&t=31531&p=244015#p244015
Dim Ws1 As Worksheet: Set Ws1 = Worksheets("Sheet1")
Dim arrSN() As Variant: Let arrSN() = Ws1.Range("G2:G" & Ws1.Range("G" & Rows.Count & "").End(xlUp).Row & "").Value ' range of current SNs
Dim arrGrpsOut() As String: ReDim arrGrpsOut(1 To 1) ' 1 Dimensional  Array for output values.
Dim cnt As Long, Cnt2 As Long, Rng2 As Long, Rng1 As Long, Rws As Long
    For cnt = LBound(arrSN(), 1) To UBound(arrSN(), 1)
    Dim SpltRng() As String: Let SpltRng() = Split(arrSN(cnt, 1), " - ", 2, vbBinaryCompare)
    Dim arrRws() As Variant 'Array for 1 2 3 4 5 6 7 etc
    Let arrRws() = Evaluate("=row(" & SpltRng(0) & ":" & SpltRng(1) & ")") ' This returns a one "column" 2 Dimensional array of all the numbers between the ranges
    Let Rng1 = UBound(arrGrpsOut()) + 1 ' The start of a range must be just above the last one
    Let Rng2 = Rng1 + SpltRng(1) - SpltRng(0) ' 'this gives the top of the current range in indicies of arrGrpsOut()
    ReDim Preserve arrGrpsOut(1 To Rng2)
        For Cnt2 = Rng1 To Rng2
        Let arrGrpsOut(Cnt2) = arrRws(Cnt2 - Rng1 + 1, 1) ' Cnt2 is the indicie in arrGrpsOut(), for the indicie in arrRws() we need to start at 1, then 2 3 4 5
        Next Cnt2
    Next cnt

Dim arrOut() As String: ReDim arrOut(1 To UBound(arrGrpsOut()) - 1, 1 To 1) ' a 2 dimension, 1 column , to be easy to post the results of this array into a column
    For cnt = 1 To UBound(arrGrpsOut()) - 1
    Let arrOut(cnt, 1) = arrGrpsOut(cnt + 1)
    Next cnt

 Let Ws1.Range("L2").Resize(UBound(arrOut(), 1), 1) = arrOut()
End Sub

---

_____ Workbook: Sample.xlsm ( Using Excel 2007 32 bit )

SN		Some expected result	Number inside Group
1 - 244	1600 - 1843		244		1	1600
245 - 448	700 - 903		204		2	1601
449 - 750	398 - 699		302		3	1602
751 - 1003	1844 - 2096		253		4	1603
1004 - 1266	1144 - 1406		263		5	1604
1267 - 1489	2097 - 2319	1 - 223	223		6	1605
1490 - 1698	189 - 397		209		7	1606
1699 - 1938	904 - 1143	224 - 463	240		8	1607
1939 - 2126	1 - 188		188		9	1608
2127 - 2319	1407 - 1599		193		10	1609
			2319		11	1610
					12	1611
					13	1612
					14	1613
					15	1614
					16	1615
					17	1616
					18	1617
					19	1618
					20	1619
					21	1620
					22	1621
					23	1622
					24	1623
					25	1624
					26	1625
					27	1626
					28	1627
					29	1628
					30	1629
					31	1630
					32	1631
					33	1632
					34	1633

Worksheet: Sheet1

FinalKandLColumns.JPG : https://imgur.com/NF6f2vL
Attachment 2124

Code for suppot of this Thread:
http://eileenslounge.com/viewtopic.php?f=30&t=31540

Code:

---

Sub SpltTests()
 Call Splt(1, 244, 1377, 1620)
End Sub
Function Splt(ByVal N1a As Long, ByVal N1b As Long, ByVal N2a As Long, ByVal N2b As Long) As Variant ' Variant as I don't know yet what might be wanted as output
Rem 1 full columns of data - full data arrays
Dim Clm1() As Variant: Let Clm1() = Evaluate("=row(" & N1a & ":" & N1b & ")")  ' This returns a one "column" 2 Dimensional array of all the numbers between N a and N b
Dim Clm2() As Variant: Let Clm2() = Evaluate("=row(" & N2a & ":" & N2b & ")")
Rem 2 get total number of arrays needed
Dim En As Long ' We want
 Let En = Int(((N1b - N1a) + 1) / 40) + 1
Rem 3a Not so simple maths to get some grouped numbers for top left of output arrays
' I need rows 1,1,1,42,42,42,83, columns 1,4,7,1,4,7,1
Dim ltrEn As String: Let ltrEn = Cltr(En) ' column letter from column number - G in example data
Dim ltrEnPlus3 As String: Let ltrEnPlus3 = Cltr(En + 3)
Dim Rws() As Variant ' row co ordinates of outout arrays
 Let Rws() = Evaluate("=Index((int((column(D:" & ltrEnPlus3 & ")-1)/3)),)") ' Evaluate("=Index((int((column(D:J)-1)/3)),)") 'returns {1, 1, 1, 2, 2, 2, 3}
Dim Clms() As Variant ' column co ordinates of output arrays
 Let Clms() = Evaluate("=Index((mod(column(A:" & ltrEn & ")-1,3)+1),)") ' Evaluate("=Index((mod(column(A:G)-1,3)+1),)") 'Returns { 1, 2, 3, 1,  2, 3, 1 }
Dim Cnt '  Loop for all data sections ==================================================
    For Cnt = 1 To En
    Rem 3b Top left for each array
    Dim rTL As Long, cTL As Long
    Let rTL = ((Rws(Cnt) - 1) * 41) + 1 ' In the looping this will give 1,1,1,42,42,42,83
    Let cTL = ((Clms(Cnt) - 1) * 3) + 1 ' In the looping this will give 1,4,7,1,4,7,1
    Rem 4 Columns of data for each loop
    Dim ClmOut1() As Variant, ClmOut2() As Variant '4a) use Index with arrays to get part of the sections from full data arrays
    Let ClmOut1() = Application.Index(Clm1(), Evaluate("=column(" & Cltr(((Cnt - 1) * 40) + 1) & ":" & Cltr(Cnt * 40) & ")"), 0) ' column 1
    Let ClmOut2() = Application.Index(Clm2(), Evaluate("=column(" & Cltr(((Cnt - 1) * 40) + 1) & ":" & Cltr(Cnt * 40) & ")"), 0) ' column 2
    Dim ClmOut1_1(1 To 40, 1 To 1) As Variant, ClmOut2_1(1 To 40, 1 To 1) As Variant ' I need Variant so as to get empty back for last array in loop paste out
    Dim Cnt2 As Long '4b) Loop to get convenient for output  2 dimensional 1 column arrays
        For Cnt2 = 1 To 40
            If IsError(ClmOut1(Cnt2)) Then Exit For ' To stop filling last array for large than top range value
        Let ClmOut1_1(Cnt2, 1) = ClmOut1(Cnt2) ' column 1
        Let ClmOut2_1(Cnt2, 1) = ClmOut2(Cnt2) ' column 2
        Next Cnt2
    Rem 5 Output of arrays to worksheet
    '5a Title
    Dim Tital(1 To 1, 1 To 2) As String: Let Tital(1, 1) = "S1": Let Tital(1, 2) = "S2"
    '5b Columns of data
    Dim WsRes As Worksheet: Set WsRes = Worksheets("Result")
    WsRes.Cells.Item(rTL, cTL).Resize(1, 2).Value = Tital() ' Title
    WsRes.Cells.Item(rTL + 1, cTL).Resize(40, 1).Value = ClmOut1_1() ' column 1
    WsRes.Cells.Item(rTL + 1, cTL + 1).Resize(40, 1).Value = ClmOut2_1() 'column 2
    Erase ClmOut1_1(), ClmOut2_1() ' without doing this out last array will not have any empties in it
    Next Cnt ' =============================================================================
End Function

' Column letter  http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980
Function Cltr(ByVal lclm As Long) As String 'Using chr function and Do while loop      For example http://www.excelforum.com/excel-programming-vba-macros/796472-how-to-go-from-column-number-to-column-letter.html
    Do
    Let Cltr = Chr(65 + (((lclm - 1) Mod 26))) & Cltr
    Let lclm = (lclm - (1)) \ 26 'This gives the number of 26's ( if any ), but just the excact part, in the next number down , - so applying the rest formula to this new number will again leave a difference "left over" rest.
    Loop While lclm > 0 'Only loop further if number was big enough to still have 0-25's in it
End Function
'Dim arr1_40() As Variant: Let arr1_40() = Evaluate("=column(A:AN)") ' {1, 2, 3 ....40}

---

_.__________________________

It will take numbers like 1, 244, 1377, 1620 and then give your wanted result (I think, like Hans said, your test data is a bit wrong – check your row 82 should be 83 I think )
The function is hard coded inside for 40 data rows, and 3 columns of Result data, but you could easily adapt that for different numbers
Rem 1 gives the entire 2 columns of results , similar to in some of your last Threads. Full data arrays are got here for the ranges, ( in your example 1 - 244 and 1377 – 1620 )

Rem 2 does some simple maths to get the number of final sections, ( 7 in your example )

Rem 3 does some not so simple maths to get
row and column, Top left indices,
rTL and cTL , of where the output should go. You want
1,1,1,42,42,42,83 and 1,4,7,1,4,7,1

Rem 4 Uses Index( arrIn() , {1,2,3,4 } , 0 ) type stuff that you know about for pulling out part of an array to get the data section columns of data

Rem 5 Pastes out to the worksheet

Alan



Typical Output as seen in the next 2 posts,

First 3 section output after running Sub SpltTests() from last post ( http://www.excelfox.com/forum/showth...0881#post10881 , https://tinyurl.com/yd95w5v2 )

_____ Workbook: Sample.xlsm ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H
1	S1	S2		S1	S2		S1	S2
2	1	1377		41	1417		81	1457
3	2	1378		42	1418		82	1458
4	3	1379		43	1419		83	1459
5	4	1380		44	1420		84	1460
6	5	1381		45	1421		85	1461
7	6	1382		46	1422		86	1462
8	7	1383		47	1423		87	1463
9	8	1384		48	1424		88	1464
10	9	1385		49	1425		89	1465
11	10	1386		50	1426		90	1466
12	11	1387		51	1427		91	1467
13	12	1388		52	1428		92	1468
14	13	1389		53	1429		93	1469
15	14	1390		54	1430		94	1470
16	15	1391		55	1431		95	1471
17	16	1392		56	1432		96	1472
18	17	1393		57	1433		97	1473
19	18	1394		58	1434		98	1474
20	19	1395		59	1435		99	1475
21	20	1396		60	1436		100	1476
22	21	1397		61	1437		101	1477
23	22	1398		62	1438		102	1478
24	23	1399		63	1439		103	1479
25	24	1400		64	1440		104	1480
26	25	1401		65	1441		105	1481
27	26	1402		66	1442		106	1482
28	27	1403		67	1443		107	1483
29	28	1404		68	1444		108	1484
30	29	1405		69	1445		109	1485
31	30	1406		70	1446		110	1486
32	31	1407		71	1447		111	1487
33	32	1408		72	1448		112	1488
34	33	1409		73	1449		113	1489
35	34	1410		74	1450		114	1490
36	35	1411		75	1451		115	1491
37	36	1412		76	1452		116	1492
38	37	1413		77	1453		117	1493
39	38	1414		78	1454		118	1494
40	39	1415		79	1455		119	1495
41	40	1416		80	1456		120	1496
42	S1	S2		S1	S2		S1	S2
43	121	1497		161	1537		201	1577

Worksheet: Result

4, 5, 6 and 7 data section output after running Sub SpltTests() from http://www.excelfox.com/forum/showth...0881#post10881
https://tinyurl.com/yd95w5v2

_____ Workbook: Sample.xlsm ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H
41	40	1416		80	1456		120	1496
42	S1	S2		S1	S2		S1	S2
43	121	1497		161	1537		201	1577
44	122	1498		162	1538		202	1578
45	123	1499		163	1539		203	1579
46	124	1500		164	1540		204	1580
47	125	1501		165	1541		205	1581
48	126	1502		166	1542		206	1582
49	127	1503		167	1543		207	1583
50	128	1504		168	1544		208	1584
51	129	1505		169	1545		209	1585
52	130	1506		170	1546		210	1586
53	131	1507		171	1547		211	1587
54	132	1508		172	1548		212	1588
55	133	1509		173	1549		213	1589
56	134	1510		174	1550		214	1590
57	135	1511		175	1551		215	1591
58	136	1512		176	1552		216	1592
59	137	1513		177	1553		217	1593
60	138	1514		178	1554		218	1594
61	139	1515		179	1555		219	1595
62	140	1516		180	1556		220	1596
63	141	1517		181	1557		221	1597
64	142	1518		182	1558		222	1598
65	143	1519		183	1559		223	1599
66	144	1520		184	1560		224	1600
67	145	1521		185	1561		225	1601
68	146	1522		186	1562		226	1602
69	147	1523		187	1563		227	1603
70	148	1524		188	1564		228	1604
71	149	1525		189	1565		229	1605
72	150	1526		190	1566		230	1606
73	151	1527		191	1567		231	1607
74	152	1528		192	1568		232	1608
75	153	1529		193	1569		233	1609
76	154	1530		194	1570		234	1610
77	155	1531		195	1571		235	1611
78	156	1532		196	1572		236	1612
79	157	1533		197	1573		237	1613
80	158	1534		198	1574		238	1614
81	159	1535		199	1575		239	1615
82	160	1536		200	1576		240	1616
83	S1	S2
84	241	1617
85	242	1618
86	243	1619
87	244	1620
88

Worksheet: Result

Main Routine in support of these Threads Part 1
http://www.excelfox.com/forum/showth...0893#post10893
http://www.eileenslounge.com/viewtopic.php?f=21&t=31572

The coding is split into 2 parts to fil it into a Forum Post. But this and the coding in the next post form a single routine. That forms the main routine. In addition, a routine Called by the Main routine is required, Public Sub GetElemsText( ) , which is posted in the over next post.

Code:

---

Option Explicit
Sub EP() '    http://www.excelforum.com/showthread.php?t=1148621&page=7&p=4452110&highlight=#post4452110
Rem 1)File Info
'Dim wsLkUp As Worksheet: Set wsLkUp = ThisWorkbook.Worksheets("Tabelle1"): wsLkUp.Activate
Dim strURL As String ' File with Page ' file:///G:/Excel0202015Jan2016/OffenFragensForums/eileenslounge/XP/Updates/report.html
Let strURL = ThisWorkbook.Path & "\Updates\" & "report.html" ' '"http://www.ernaehrung.de/lebensmittel/de/W233000/Fleischkaese.php" ' "http://www.ernaehrung.de/lebensmittel/de/W233000/PloppyPooFukYou"
' Application.Wait Now + TimeValue("00:00:02") '
Rem 2) '
'2a  xmlHTTP stuff  MSXML2.XMLHTTP.6.0    IXMLHTTPRequest  Alan: "simple xml request here, so you could give URL a simple File of the HTML code"      'Dim Request As Object: Set Request = CreateObject("MSXML2.XMLHTTP") 'Late Inding                    https://msdn.microsoft.com/en-us/library/ms759148(v=vs.85).aspx
Dim request As MSXML2.XMLHTTP:  Set request = New MSXML2.XMLHTTP 'Early Binding Requires --- TOOLS --- REFERENCES -- tick Microsoft XML, v6.0    http://www.mrexcel.com/forum/excel-questions/759592-help-createobject-msxml2-xmlhttp-macro.html
'Application.Cursor = xlWait'cursor disable..just to be on the safe side???
  With request '(or With CreateObject("msxml2.xmlhttp"))'By virtue of GET this is a simplified "xml" request
    .Open bstrmethod:="GET", bstrURL:=strURL, varasync:=True '  ("GET", strURL, True) 'just preparing the request type, how and what type. The second argument determines type. This may then require further info in next lines    Only diferrence to pike's and Kyle's opening and sending stuff is argument:- Leith: "The True/False argument of the HTTP Request is the Asynchronous mode flag. If set False then control is immediately returns to VBA after Send is executed. If set True then control is returned to VBA after the server has sent back a response. I prefer to use asynchronous mode and test if my timeout period has expired to prevent the code from hanging due to an unresponsive server. In the example I provided I used synchronous mode to reduce the amount the code and keep it easier to understand."
    'No extra info here for type GET    '                      '  '.setRequestHeader "DNT", "1"
    '.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" ' Content-Type is the property name, x-www-form-urlencoded is the value (content type in the html is "text/html" not "x-www-form-urlencoded" - that is something diifferent) You can have different request header properties and pass different values. This isn't unusual, just not required in this case  When you POST data to a server, you need to tell it what format you are sending it in. So the Type of Content sent in the body of the request (the send bit) is application/x-www-form-urlencoded
    .setRequestHeader bstrheader:="Ploppy", bstrvalue:="Poo"
    .send ' varBody:= ' No extra info for type GET. .send actually makes the request
        While .readyState <> 4: DoEvents: Wend ' Allow other processes to run while the web page loads. Think this is part of the True option
  Dim PageSrc As String: Let PageSrc = .responseText ' Save the HTML code in the (Global) variable. ': Range("P1").Value = PageSrc 'For me for a print out copy to text file etc.    The responseText property returns the information requested by the Open method as a text string
  End With
Set request = Nothing ' This section is finished. We no longer need the Library. Optionally can therefore Set request = Nothing, a step most appropriate if required for some reason. Previous arguments of good practice to prevent memory leaks and data corruption appear outdated in favour of only using when a good reason is apparent to avoid masking when it is a good idea.
'_..EP2ab Explicit Pedantry.  We intend using PagrSrc through a method to produce a model  Object Orientated stylio for later use through  use of its Methods and Properties. This model is frequently referred to as a Document Orientated Model, DOM. Some steps in this creation of the "DOM" can frequently be confused with the processes in '2a which are in fact now finished. Part of the .Send , "finishes all processes. We move on to '2b. Only PagrSrc is required to be "taken over" as it were
'2b DOM stuff' Make OOP type model of HTML code, using Microsoft HTML Office Library
'Dim HTMLdoc As HTMLDocument: Set HTMLdoc = New HTMLDocument 'Early binding - will not work with .Write:- Leith "This is a case where late binding has to be used. The htmlfile is an ActiveX object that is a wrapper function for the IHTMLDocument2 interface in MSXML2. This gets into a lot of low level system operation......."  https://www.mrexcel.com/forum/excel-questions/367030-copy-table-website-into-excel-vba-2.html#post4031122    https://www.excelforum.com/excel-programming-vba-macros/1214789-late-binding-2.html#post4820307    'Early binding TOOLS >>> REFERENCES >>Microsoft HTML Object Library
Dim HTMLdoc As Object: Set HTMLdoc = CreateObject("htmlfile") 'Late Binding, ' Create an empty HTML Document.
 HTMLdoc.Open 'EP2b(i)  This clears the values in the HTMLdoc. Complete Explicit Pedantry. in usage outside VBA, Methods for an instance will often be required which require a clearing of an instance before "using". Approximately in VBA this can be considered putting the DOM back to as if it were at the point just before it is given "loaded" with the PageSrc String. Effectively in VBA doing a pair of Set = Nothing , with either a Dim  and Create Dom or Set = New type code line  It serves no purpose usually in VBA. Effectively we reset a situation back to as it is. It can however be used through .Open
 HTMLdoc.Write PageSrc 'EP2b(ii).  Convert the HTML code into an HTML Document Object Model, DOM 'give it somehow the info it needs to work further? ---- Fills the DOM HTML  .. Wiki Dom  http://www.excelforum.com/showthread.php?t=1148621&page=3#post4441761
 'HTMLdoc.body.innerHTML = PageSrc ' Most people do that, but The Write method of an HTML file is designed to convert the page source text into an HTML DOM document. Both methods achieve the same results. The more common way Body of the Page Source code when converting it to an HTML DOM document oustside of VBA. Withiin VBA it just works harder to achieve the same. This excludes the Meta data, Java scripts, and Class information from being converted. Generally speaking, this information is not used when retrieving only text data from a web page.
 HTMLdoc.Close 'EP2b(iii)  _ 2 b or not in 2b , that was the ??  http://www.excelforum.com/showthread.php?t=1148621&page=6.. Briefly When used outside VBA, some processes started by .Open() can  or should be finished after the corresponding outside VBA .write(). This is done using .Close(). Once again this can be used in VBA through .Close.  It has no conceivable merit or known as yet reason to use it in VBA. Pike thinks it It closes the document you have just written. As such he describes it as optional. He would also not have the HTMLdoc.Open. Kyle thinks nothing is open. Leith uses it but has made no comment to Date. This may be just his style, like my EP's just not including the HTMLdoc.Open 'EP2b(i)
Rem 3
Rem 3a) Directly

---

UDF that can change values in cells other than the cell in which the UDF is used

This Tips Thread was inspired by this one posted by Rick Rothstein
I have referred to that posting from Rick quite a few times when showing people how to use a UDF to do things with a UDF in cells other than that in which the UDF is, and mostly pretty impressed they have been too. ( Those that weren’t impressed were those that did not believe it and never tried…. )

I finally got around to trying to get my head around this, and here is my take on it. If you are only interested in seeing the working examples, then jump to post 3

If you are familiar with Ricks ways of doing this, then basically I am using his solutions but just not using the hyperlink. There’s not much more to it then that. I came there from a long winded way which I am discussing in the next post, but the key to it working is based on, or using, the way Rick used the Evaluate within the coding for the UDF that is in the worksheet

_______ Evaluate__ "SomeOtherProcedureToDoAnythingAnywhere(ArgY, __)"


Here again below, the solution a bit more fully: Below is the coding as you would write it in a normal code module , assuming that the Function MainUDF( ) is the UDF which you would use in the usual formula type way in a worksheet cell like __ = MainUDF( )
http://i.imgur.com/58IFQoQ.jpg

___Function MainUDF(__) ' UDF to be used in a worksheet cell like__ = MainUDF(ArgX)
____ ' any coding to do anything not related to changing things in the worksheet in which the UDF is used
____ '
_______ Evaluate__ "SomeOtherProcedureToDoAnythingAnywhere(ArgY, __)"
____ '
____ ' any coding to do anything not related to changing things in the worksheet in which the UDF is used
____ '
___End Function

---

Simplest Working Example:
The simplest example is something like the following:
Copy both procedures to a normal code module , …_

Code:

---

'  Paste both procedures in a normal code module, then  type  =ChangeNextCell()  in any cell followed by  Enter
Function ChangeNextCell()
'  Call NextCell          '  This wont work. We will be on the same dependancy in the called procedure and cell dependancies are already calculated so attempts to access cells will be screwed up
 Evaluate "NextCell()"    '  The dependance tree is recalculated for the procedure  NextCell()  which  is excecuted from a copy of the procedure not dependant on the spreadsheet update cycle in progress for the excecution of the function  ChangeNextCell()
End Function
Sub NextCell()
 ActiveCell.Offset(0, 1).Value = "Next cell."        '  Excel has a memory of the last  Active Cell  and does not rely on dependance to the spreadsheet for this macro to run
End Sub

---

_... then type in any cell the function _ =ChangeNextCell() _ then _ Enter

ChangeNextCell.JPG : http://i.imgur.com/nqHHEfb.jpg https://imgur.com/nqHHEfb
https://i.imgur.com/nqHHEfb.jpg

ChangeNext Cell.JPG : http://i.imgur.com/iAQFUrj.jpg https://imgur.com/iAQFUrj
https://i.imgur.com/iAQFUrj.jpg

Change Next Cell.JPG : http://i.imgur.com/V7Lowxp.jpg https://imgur.com/V7Lowxp
https://i.imgur.com/V7Lowxp.jpg

---

In the next post some attempt to examine what’s going on. It is not complete; I may need to come back again on this one

Part 2 of Main code.
This coding in this post should be copied diretly under the coding from the last post. Together they form a single routine, the Main routine

(The routine, Public Sub GetElemsText( ) , which is posted in the next post is also required for the Main routine to work )

Code:

---

Rem 3a) Directly
'
'
'    Simple text file print out using just result of  PageSrc  from '2a
    Debug.Print PageSrc ' unfortunately you will unlikely be able to view the whole String as it appears too big. Also pasting to a cell will not make it all visible. However if after pasting the .value from the cell is put in a string and that used in place of Pagesrc in the creation of the DOM it does work, so indicating that the data is there, but just not possible for us to "see".
    Dim strTextFile As String: Let strTextFile = ThisWorkbook.Path & "\Updates\strTextFile.txt"
    Dim HghWyNo2 As Long: Let HghWyNo2 = FreeFile(RangeNumber:=1)
    Open strTextFile For Binary As #HghWyNo2
    Put #HghWyNo2, 1, PageSrc '  Use Put to write the whole array at once  http://www.vb-helper.com/howto_read_write_binary_file.html  https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/put-statement
    Close HghWyNo2
'
'
'
'Application.Cursor = xlDefault' Restore the cursor to normal.
Rem 3b) Large Object from main made OOP type model object, (HTMLdoc)    ( Rem 3b)(i) )          ' Dim Head As Object
'Dim Head As IHTMLElementCollection 'requires Early Binding. getElementsBy___ returns a NodeList which is an interface to the DispHTMLElementCollection which is an internal class that you're not supposed to see/use. It does implement the IHTMLElementCollection though so you can use that.
Dim Head As Object ' Unusually this Large main Object is Dim ed as an Object, ..as you find you cannot Dim it as what its TypeName( ) returns ( or as displayed in the Watch Window ), “DispHTMLElementCollection“ .
 Set Head = HTMLdoc.getElementsByTagName("Table") 'This Object is a massive thing again with loads in, but this time it would appear to be the things "tagged" with < table >  < /table > which look like the headings of each table I am interested in
Rem 4)(Rem 3b)(ii)) Often we would loop here for each "Table" but in our example we only have one
'Dim oTable  As THMLTable ' If we had Early binding, then this would work, because omehow  Head  has been recognised as a table  oTable as HTMLTable.JPG : https://imgur.com/R309JjC , and for ..._
Dim oTable  As Object ' _... this table we have typically present in the object  ' HTML TableRow count , "column" Count for final Table will need to be calculated, "HTML Cell" count in Entire Table
Dim C As Long, r As Long 'Indicies for getting appropriate Row and HTMLTableCell
'Dim n As Long ' Not needed if only one table so only "1 Loop"
'4b)=== main working would be Outer loop for each Table in many similar routines==============Building Array from HTML Table
'For n = 0 To Head.Length - 1 ' We only have one table so don't need to loop. The word Length in HTML things is often similar to what Count is in many VBA objects
 Set oTable = Head(0) ' Somehow  Head  has been recognised as a table  oTable as HTMLTable.JPG : https://imgur.com/R309JjC
'4b(i) Fill variable for dimensions variable for each, one on our case, Main loop
Dim rowCnt As Long: Let rowCnt = oTable.Rows.Length  ' "length" / number of rows in this table
Dim colCt As Long:  Let colCt = oTable.Cells.Length 'In this object the cells "length" would appear to be the number / count of cells in the entire table
Dim colCnt As Long: Let colCnt = Application.WorksheetFunction.RoundUp((colCt / oTable.Rows.Length), 0) ' 'This rounds up to the nearest avarage row width, that is to say column number in a row  '  I thought this did ? colCt \ oTable.Rows.Length
Dim Data() As String 'Array with string element used for output table. Fixed (static) String type for Text.
    ReDim Data(0 To rowCnt - 1, 0 To colCnt - 1) 'Output Array, reDimed to table being looked at. ( Hopefully always same column number, might want to hard Code to  rowCnt, 11 columns . Because I am using "base" of indicie to start at 0 then I go from 0 to one less than the Count(Length)
'4b(ii)  Looping through rows to build output array-----------|
'---Inner loop does at each row, ....
        For r = 0 To rowCnt - 1 'Going along the HTML Table rows exactly as pike ' https://www.mrexcel.com/forum/excel-questions/367030-copy-table-website-into-excel-vba.html#post4026613
'--- .... 'go through each Cell( "column" )  in that row.
            For C = 0 To colCnt - 1 'Going along the HTML Table Cells (columns) exactly the same as pike
'4b(ii)a Build Output Array
            Call GetElemsText(oTable.Rows(r).Cells(C), Data(r, C))  'Data(r, c) = oTable.Rows(r).Cells(c).innerText '  pike, kyle type alternative to calling sub
'4b(ii)b "post processing last column of unified units. ' Probably bad place to put this, other than Speed.. checking / changing units
'                If C = .....
'
'                Else
'                End If
            Next C
'--- .... 'go to next "Cell" in that table row (next Column we "see" in the table row)
        Next r
'---  'Go to next row in this table----------------------------|
'4b(ii)c  Output from Array
 Let Range("A1").Resize(UBound(Data(), 1) + 1, UBound(Data(), 2) + 1).Value = Data()
 Columns("A:Z").AutoFit
'Next n 'go back with a new item, n in large collection Object(item) to get next object within and start checking that one out.
'Go to the next table====
Set HTMLdoc = Nothing ' If done then  when we no longer need it
End Sub '

---