Tests Copying pasting Cliipboard issues. and otes on API stuff

**DocAElstein** · 02-09-2022, 11:45 PM

docs.microsoft.com
learn.microsoft.com

https://web.archive.org/web/20230121...m-renderformat 12/12/2020

https://web.archive.org/web/20191230...m-renderformat 05/31/2018

WM_RENDERFORMAT message

**DocAElstein** · 03-28-2022, 04:13 PM

In support of these issues
https://excelfox.com/forum/showthrea...ge51#post12784 https://www.youtube.com/watch?v=dKM8ZScbic8&t=75s
Winget issues https://github.com/ChrisTitusTech/wi...770ae56d3b6e85
https://github.com/ChrisTitusTech/wi...b236f3ecf290db

06.07.2021 The Best Windows Utility ( second nice shade of grey GUI )

Code:

Write-Host "Checking winget..."

Try{
	# Check if winget is already installed
	$er = (invoke-expression "winget -v") 2>&1
	if ($lastexitcode) {throw $er}
	Write-Host "winget is already installed."
}
Catch{
	# winget is not installed. Install it from the Github release
	Write-Host "winget is not found, installing it right now."
	
	$download = "https://github.com/microsoft/winget-cli/releases/download/v1.0.11692/Microsoft.DesktopAppInstaller_8wekyb3d8bbwe.msixbundle"
	$output = $PSScriptRoot + "\winget-latest.appxbundle"
	Write-Host "Dowloading latest release"
	Invoke-WebRequest -Uri $download -OutFile $output
	
	Write-Host "Installing the package"
	Add-AppxPackage -Path $output
}
Finally {
	# Start installing the packages with winget
	#Get-Content .\winget.txt | ForEach-Object {
	#	iex ("winget install -e " + $_)
	#}
}

The Ultimate Windows Utility Upgrade 29 09 2021

Code:

Write-Host "Checking winget..."

Try{
	# Check if winget is already installed
	$er = (invoke-expression "winget -v") 2>&1
	if ($lastexitcode) {throw $er}
	Write-Host "winget is already installed."
}
Catch{
	# winget is not installed. Install it from the Microsoft Store
	Write-Host "winget is not found, installing it right now."

	Start-Process "ms-appinstaller:?source=https://aka.ms/getwinget"
	$nid = (Get-Process AppInstaller).id
	Wait-Process -Id $nid

}
Finally {
	# Start installing the packages with winget
	#Get-Content .\winget.txt | ForEach-Object {
	#	iex ("winget install -e " + $_)
	#}
}

A commit a bit later by mrhaydendp to simplify a bit https://github.com/ChrisTitusTech/wi...0db?diff=split

Code:

Write-Host "Checking winget..."

# Check if winget is installed
if (Test-Path ~\AppData\Local\Microsoft\WindowsApps\winget.exe){
    'Winget Already Installed'
}  
else{
    # Installing winget from the Microsoft Store
	Write-Host "Winget not found, installing it now."
	Start-Process "ms-appinstaller:?source=https://aka.ms/getwinget"
	$nid = (Get-Process AppInstaller).Id
	Wait-Process -Id $nid
	Write-Host Winget Installed
}

**DocAElstein** · 04-16-2022, 10:23 PM

Test

17-121-114-118.applebot.apple.com

header1	header2	A Header	Last Column Header
0	SubItem	SubItem	SubItem	SubItem	<-- This is a ListView Item. It has an Item number of 0 and an Item idenitfier/name of 345
1	SubItem	SubItem	SubItem	SubItem	<-- This is a ListView Item. It has an Item number of 1 and an Item idenitfier/name of 232
2	SubItem	SubItem	SubItem	SubItem	<-- This is a ListView Item. It has an Item number of 2 and an Item idenitfier/name of 36

[size]

header1	header2	A Header	Last Column Header
0	SubItem	SubItem	SubItem	<-- This brown thing is a ListView Item. It has an Item number of 0 and an Item idenitfier/name of 345
1	SubItem	SubItem	SubItem	<-- This blue thing is a ListView Item. It has an Item number of 1 and an Item idenitfier/name of 232
2	SubItem	SubItem	SubItem	<-- This purple thing is a ListView Item. It has an Item number of 2 and an Item idenitfier/name of 36

header1	header2	A Header	Last Header	<-- This bit with the created “column” is part of the main ListView object
₀\³⁴⁵	SubItem	SubItem	SubItem	<-- This brown thing is a ListViewItem object. It has an Item number of 0, and an Item identifier/name of 345
₁\²³²	SubItem	SubItem	SubItem	<-- This blue thing is a ListViewItem object. It has an Item number of 1, and an Item identifier/name of 232
₂\³⁶	SubItem	SubItem	SubItem	<-- This purple thing is a ListViewItem object. It has an Item number of 2 and an Item identifier/name of 36

__
In the above schematic we are showing 4 objects. The last three belong to the first one, ( after they have been ned to it ).
The values in the first column somehow belong to the main ListView object.
SubItems are Added to the ListViewItems

**DocAElstein** · 04-26-2022, 12:19 PM

In support of this Thread https://eileenslounge.com/viewtopic.php?f=30&t=38110
https://eileenslounge.com/viewtopic....294721#p294721

Vertical to Horizontal,
This

to this

Part 1 The main data Vertical to Horizontal
An idea I have is to build up the single string that we know can be put into the Windows Clipboard, and then pasted out into Excel. ( http://www.eileenslounge.com/viewtop...242941#p242941 )
I basically build that up with some Do While Loopy stuff

The Full Story
The usual worksheets defining and data getting information stuff.
( We capture one extra empty row, because, past experience with these sort of Do While Loopy stuff has shown that it can help simplify some conditional comparison things and/ or help prevent arrays doing out of bounds by one row.

Rem 1
The purpose of this is to get that maximum Amounts or Notes count, ( the biggest group ) ( which is 4 in the given example )
But its worth looking at how that works since the basic Do While Loop is then used in the next main ( Rem 2 ) section.
The #### Main Outer Loop keeps us going through all data rows
Within that the ' ---- Inner Loop that takes us through a group
This loop adds the things in the group, and after each loop is finished we check If the count was the biggest group so far.

Rem 2
This is the main meat of the solution.
First, exactly as before we have a #### Main Outer Loop keeps us going through all data rows

Within that Main Outer Loop we now have 2 inner loops.
'2a
The '2a The first inner loop one does something similar to before. It loops for a group. This time within it we build up two strings that we need for a line in the output.
As example, for the first group we are basically trying to build up these two strings, ( Just before we start that loop, we tack onto the string at the start the group name, which is A in the first group example.
This is what we would see, for example in the immediate window, for querying the string content after, in this example, the the loops for that inner loop

Code:

 ?  strClipL
A   vbTab  10 vbTab     20 vbTab     30  

?    strClipR
  vbTab    N1  vbTab  N2  vbTab  N3

( For the sake of clarity I use a vbTab to indicate the “invisible” vbTab characters, which is actually on those strings )
'2b
The purpose of '2b the second inner loop is to ,( if necessary ), give us effectively extra empty cells, ( achieved by adding a vbTab of the strings.
Using the same example, we would see that the loop is needed to be done once, and at the end of that single loop, our strings are modifies such:

Code:

 ?  strClipL
A   vbTab  10 vbTab     20 vbTab     30   vbTab  

?    strClipR
  vbTab    N1  vbTab  N2  vbTab  N3  vbTab

'2c
At this point we combine the two strings and add a line separator so that this row data can be added onto by the next row data
So as to be sure what I have and demonstrate it more clearly, I added a line in testing which calls a function of mine , ( https://excelfox.com/forum/showthrea...ll=1#post15522 ) , which checks that line screen,
Here is the result

Code:

"A" & vbTab & "10" & vbTab & "20" & vbTab & "30" & vbTab & vbTab & "N1" & vbTab & "N2" & vbTab & "N3" & vbTab & vbTab & "GroupA" & vbCr & vbLf

That looks about correct.

Doing a few other tests, suggest to me that I have the final result that I need:

Code:

 ? strclip
A   10  20  30      N1  N2  N3      GroupA
B   40  50  60  70  N4  N5  N6  N7  GroupB
C   80              N8              GroupC
D   90  100         N9  N10         GroupD


"A" & vbTab & "10" & vbTab & "20" & vbTab & "30" & vbTab & vbTab & "N1" & vbTab & "N2" & vbTab & "N3" & vbTab & vbTab & "GroupA" & vbCr & vbLf & "B" & vbTab & "40" & vbTab & "50" & vbTab & "60" & vbTab & "70" & vbTab & "N4" & vbTab & "N5" & vbTab & "N6" & vbTab & "N7" & vbTab & "GroupB" & vbCr & vbLf & "C" & vbTab & "80" & vbTab & vbTab & vbTab & vbTab & "N8" & vbTab & vbTab & vbTab & vbTab & "GroupC" & vbCr & vbLf & "D" & vbTab & "90" & vbTab & "100" & vbTab & vbTab & vbTab & "N9" & vbTab & "N10" & vbTab & vbTab & vbTab & "GroupD" & vbCr & vbLf

' Ref
' http://www.eileenslounge.com/viewtop...=31395#p242941
' http://www.eileenslounge.com/viewtop...=31489#p243731
' http://www.eileenslounge.com/viewtop...=31938#p247681
' http://www.eileenslounge.com/viewtop...art=20#p246887
https://eileenslounge.com/viewtopic....294721#p294721
' http://web.archive.org/web/202001241...ms-dataobject/
' https://stackoverflow.com/questions/...60767#54960767
' https://stackoverflow.com/questions/...12342#59812342
‘ http://web.archive.org/web/202001241...ms-dataobject/

‘ https://www.myonlinetraininghub.com/excel-clipboard https://support.microsoft.com/en-us/...&fromar=1#bm2b
‘ https://www.thespreadsheetguru.com/b...nal-macro-file
‘ https://excelribbon.tips.net/T009810...Clipboard.html
‘ https://www.excelforum.com/excel-pro...t-working.html
‘ https://www.thespreadsheetguru.com/b...-the-clipboard
https://excelribbon.tips.net/T010691...Clipboard.html
https://excel.tips.net/T003111_Cant_...Workbooks.html

' VBA to clear the Office Clipboard http://www.eileenslounge.com/viewtop...634c64#p246838

**DocAElstein** · 04-26-2022, 06:16 PM

Coding so far , for last post, https://excelfox.com/forum/showthrea...ll=1#post16529

Code:

'  https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16529&viewfull=1#post16529
'  http://www.eileenslounge.com/viewtopic.php?f=30&t=38110&p=294692#p294692
Sub Stantial()
Rem 0 data
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets("Sheet1")
Dim RngPlus1 As Range
 Set RngPlus1 = Ws1.Cells.Item(1).CurrentRegion.Resize(Ws1.Cells.Item(1).CurrentRegion.Rows.Count + 1, Ws1.Cells.Item(1).CurrentRegion.Columns.Count)
Dim vArr() As Variant: Let vArr() = RngPlus1.Value2
Rem 1 determine the biggest group ( that maximum Amounts or Notes count )
Dim Cnt As Long, Cnt2 As Long, Mx As Long: Let Mx = 1: Let Cnt = 1
    Do  '            ############################# Main Outer Loop keeps us going through all data rows
        Do  '                           -----------------  Inner Loop that takes us through a group
         Let Cnt = Cnt + 1 ' Cnt is the main data row number
         Let Cnt2 = Cnt2 + 1
        Loop While vArr(Cnt + 1, 1) = vArr(Cnt, 1) ' ----  Inner Loop that takes us through a group
        If Cnt2 > Mx Then Let Mx = Cnt2
     Let Cnt2 = 0
    Loop While Cnt < UBound(vArr(), 1) - 1 '  #### Main Outer Loop keeps us going through all data rows

Rem 2 '            ############################# Main Outer Loop keeps us going through all data rows
 Let Cnt = 1
    Do
    Dim HrCnt As Long: Let HrCnt = 1
    Dim strClipR As String, strClipL As String: Let strClipL = strClipL & vArr(Cnt + 1, 1)
        Do                                         '2a The first inner loop
         Let Cnt = Cnt + 1
         Let HrCnt = HrCnt + 1
         Let strClipL = strClipL & vbTab & vArr(Cnt, 2)
         Let strClipR = strClipR & vbTab & vArr(Cnt, 3)
        Loop While vArr(Cnt + 1, 1) = vArr(Cnt, 1) '   The first inner loop
        Do While HrCnt < Mx + 1                    '2b the second inner loop
         Let strClipL = strClipL & vbTab
         Let strClipR = strClipR & vbTab
         Let HrCnt = HrCnt + 1
        Loop                                       '   the second inner loop
    '2c Finishing off the strings, and final string for an output line, after the inner loops
     Let strClipR = strClipR & vbTab & vArr(Cnt, 4) ' add the group name
    Dim strClip As String: Let strClip = strClip & strClipL & strClipR & vbCr & vbLf  ' join the strings and add a line seperator to the output row string
    'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strClip)
    Let strClipL = "": strClipR = ""
    Loop While Cnt < UBound(vArr(), 1) - 1 '  #### Main Outer Loop keeps us going through all data rows
 'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strClip)
'2d paste  strClip  out via the windows Clipboard
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")   '     http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
 objDataObject.SetText Text:=strClip
 objDataObject.PutInClipboard
 Ws1.Paste Destination:=Ws1.Range("G2")

End Sub

**DocAElstein** · 04-26-2022, 06:18 PM

**DocAElstein** · 04-26-2022, 06:40 PM

Following on from posts,
https://excelfox.com/forum/showthrea...ll=1#post16530 https://excelfox.com/forum/showthrea...ll=1#post16529
http://www.eileenslounge.com/viewtop...294692#p294692
,

The header row,
Group Amount1 Amount2 Amount3 Amount4 Notes1 Notes2 Notes3 Notes4 Name
, we could make partially dynamic, as is needed, since we don’t know the maximum number of amounts ( = maximum number of Notes ) , before seeing the data.

We do have the information needed, since Mx contains, in our current example, the required value of 4

Evaluate Range techniques are a convenient way to get these sort of things.

We start by considering spreadsheet formulas such as this,
={"Amount" & COLUMN(A1:D1)}
, which returns us an array, which applied across a range , would give us like
Amount1 Amount2 Amount3 Amount4

Taking that general idea and a few other steps we can finally get at our heading like in this demo coding

Code:

' https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16532&viewfull=1#post16532
Sub MakeHeadings()
Dim Mx As Long: Let Mx = 4
Dim Amounts() As Variant
 Let Amounts() = Evaluate("=""Amount"" & COLUMN(A1:D1)")
 Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:D)")
 Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:" & "D" & ")")
' We need to get   D  from what we know,  Mx
Dim vTemp As Variant
 vTemp = Cells(1, 4).Address
 vTemp = Split(vTemp, "$", 3, vbBinaryCompare)
 vTemp = vTemp(1)
' Or
 vTemp = Split(Cells(1, 4).Address, "$", 3, vbBinaryCompare)(1)
' Or
 vTemp = Split(Cells(1, 4).Address, "$")(1)
 vTemp = Split(Cells(1, Mx).Address, "$")(1)

Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:" & vTemp & ")")
Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")")
'
' We want this array as a string with   vbTabs seperating the array elements
Dim strAmounts As String
 Let strAmounts = Join(Amounts(), vbTab)
 Let strAmounts = Join(Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab)

' similarly for the  notes
Dim strNotes As String
 Let strNotes = Join(Evaluate("=""Note"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab)

' To get our final heading string,
Dim strHd As String
 Let strHd = "Group" & vbTab & Join(Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & Join(Evaluate("=""Note"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & "Notes"

Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")   '     http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
 objDataObject.SetText Text:=strHd
 objDataObject.PutInClipboard
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets("Sheet1")
 Ws1.Paste Destination:=Ws1.Range("G1")

End Sub

In the next post , https://excelfox.com/forum/showthrea...ll=1#post16533 , is that integrated into the main coding in Rem 3

**DocAElstein** · 04-26-2022, 07:40 PM

Coding for these posts
https://excelfox.com/forum/showthrea...ll=1#post16532

Code:

Sub Stantially()
Rem 0 data
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets("Sheet1")
Dim RngPlus1 As Range
 Set RngPlus1 = Ws1.Cells.Item(1).CurrentRegion.Resize(Ws1.Cells.Item(1).CurrentRegion.Rows.Count + 1, Ws1.Cells.Item(1).CurrentRegion.Columns.Count)
Dim vArr() As Variant: Let vArr() = RngPlus1.Value2
Rem 1 determine the biggest group ( that maximum Amounts or Notes count )
Dim Cnt As Long, Cnt2 As Long, Mx As Long: Let Mx = 1: Let Cnt = 1
    Do  '            ############################# Main Outer Loop keeps us going through all data rows
        Do  '                           -----------------  Inner Loop that takes us through a group
         Let Cnt = Cnt + 1 ' Cnt is the main data row number
         Let Cnt2 = Cnt2 + 1
        Loop While vArr(Cnt + 1, 1) = vArr(Cnt, 1) ' ----  Inner Loop that takes us through a group
        If Cnt2 > Mx Then Let Mx = Cnt2
     Let Cnt2 = 0
    Loop While Cnt < UBound(vArr(), 1) - 1 '  #### Main Outer Loop keeps us going through all data rows

Rem 2 '            ############################# Main Outer Loop keeps us going through all data rows
 Let Cnt = 1
    Do
    Dim HrCnt As Long: Let HrCnt = 1
    Dim strClipR As String, strClipL As String: Let strClipL = strClipL & vArr(Cnt + 1, 1)
        Do                                         '2a The first inner loop
         Let Cnt = Cnt + 1
         Let HrCnt = HrCnt + 1
         Let strClipL = strClipL & vbTab & vArr(Cnt, 2)
         Let strClipR = strClipR & vbTab & vArr(Cnt, 3)
        Loop While vArr(Cnt + 1, 1) = vArr(Cnt, 1) '   The first inner loop
        Do While HrCnt < Mx + 1                    '2b the second inner loop
         Let strClipL = strClipL & vbTab
         Let strClipR = strClipR & vbTab
         Let HrCnt = HrCnt + 1
        Loop                                       '   the second inner loop
    '2c Finishing off the strings, and final string for an output line, after the inner loops
     Let strClipR = strClipR & vbTab & vArr(Cnt, 4) ' add the group name
    Dim strClip As String: Let strClip = strClip & strClipL & strClipR & vbCr & vbLf  ' join the strings and add a line seperator to the output row string
    'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strClip)
    Let strClipL = "": strClipR = ""
    Loop While Cnt < UBound(vArr(), 1) - 1 '  #### Main Outer Loop keeps us going through all data rows
 'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strClip)
'2d paste  strClip  out via the windows Clipboard
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")   '     http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
 objDataObject.SetText Text:=strClip
 objDataObject.PutInClipboard
 Ws1.Paste Destination:=Ws1.Range("G2")

Rem 3 headers
Dim strHd As String
 Let strHd = "Group" & vbTab & Join(Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & Join(Evaluate("=""Note"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & "Name"
 objDataObject.SetText Text:=strHd
 objDataObject.PutInClipboard
 Ws1.Paste Destination:=Ws1.Range("G1")

End Sub

**DocAElstein** · 06-17-2022, 02:10 AM

Some extra notes for this main forum post:
http://www.eileenslounge.com/viewtopic.php?f=27&t=38331

This is a sample input,

_____ Workbook: Split- Copy.xlsm ( Using Excel 2007 32 bit )

_Row\^Col	A	B
2	1,2,3,4	t,y,u,m

Worksheet: Sheet2Original

This is what I want out

_____ Workbook: Split- Copy.xlsm ( Using Excel 2007 32 bit )

_Row\^Col	A	B
2	1	t
3	2	y
4	3	u
5	4	m

Worksheet: Sheet2

I want to do this sort of thing,

__ arrOut()= App.Index(arrIn(), Rws(), Clms())

The arrIn() in this case will be all the input data. Conveniently, we can join the two cell values with a comma then split all that by comma to get a single array, {1 2 3 4 t y u m }
Then we need the Rws() like this
1 1
1 1
1 1
1 1
and the Clms() like this
1 5
2 6
3 7
4 8

Code:

'  https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16639&viewfull=1#post16639
Sub SplitData4()
Dim Ws2 As Worksheet: Set Ws2 = ThisWorkbook.Worksheets.Item("Sheet2")
Dim strDta As String: Let strDta = Ws2.Range("A2").Value & "," & Ws2.Range("B2").Value
Dim arrIn() As String
 Let arrIn() = Split(strDta, ",", -1, vbBinaryCompare)
' Or
 arrIn() = Split(Range("A2").Value & "," & Range("B2").Value, ",")
Dim Rws() As Variant
 Let Rws() = Evaluate("=Row(1:4)/Row(1:4)*Column(A:B)/Column(A:B)")
 Let Rws() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")/Row(1:" & (UBound(arrIn()) + 1) / 2 & ")*Column(A:B)/Column(A:B)")
Dim Clms() As Variant
 Let Clms() = Evaluate("=Row(1:4)+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")
 Let Clms() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")

Dim arrOut() As Variant
 Let arrOut() = Application.Index(arrIn(), Rws(), Clms())

 Let Ws2.Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut()

' Or
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut()
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), Rws(), Clms())
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")/Row(1:" & (UBound(arrIn()) + 1) / 2 & ")*Column(A:B)/Column(A:B)"), Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")"))

 Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")/Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")*Column(A:B)/Column(A:B)"), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")"))
 
End Sub

Code:

Sub StantiallyBeautiful() '  http://www.eileenslounge.com/viewtopic.php?f=27&t=38331
 Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")/Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")*Column(A:B)/Column(A:B)"), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")"))
End Sub

In actual fact, we can simplify things a bit , since Intersexual interception theory tells us that if Excel is looking for the indicies of this form
A b
C d
E f
G h
, but we only give it
1
, then it will see this instead
1 1
1 1
1 1
1 1

So that means we can replace Rws() with just 1
So that all simplifies it a bit…

Code:

Sub SplitData4b()
Dim Ws2 As Worksheet: Set Ws2 = ThisWorkbook.Worksheets.Item("Sheet2")
Dim strDta As String: Let strDta = Ws2.Range("A2").Value & "," & Ws2.Range("B2").Value
Dim arrIn() As String
 Let arrIn() = Split(strDta, ",", -1, vbBinaryCompare)
' Or
 arrIn() = Split(Range("A2").Value & "," & Range("B2").Value, ",")
'Dim Rws() As Variant
' Let Rws() = Evaluate("=Row(1:4)/Row(1:4)*Column(A:B)/Column(A:B)")
' Let Rws() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")/Row(1:" & (UBound(arrIn()) + 1) / 2 & ")*Column(A:B)/Column(A:B)")
Dim Clms() As Variant
 Let Clms() = Evaluate("=Row(1:4)+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")
 Let Clms() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")

Dim arrOut() As Variant
' Let arrOut() = Application.Index(arrIn(), Rws(), Clms())
 Let arrOut() = Application.Index(arrIn(), 1, Clms())
 Let Ws2.Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut()

' Or
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut()
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), 1, Clms())
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), 1, Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")"))

 Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), 1, Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")"))
End Sub

Sub StantiallyBeautifulb() '  http://www.eileenslounge.com/viewtopic.php?f=27&t=38331
 Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), 1, Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")"))
End Sub