Tests Copying, Pasting, API Cliipboard issues. and Rough notes on Advanced API stuff

In support of this Thread:
http://www.excelfox.com/forum/showth...Paste-by-a-Vba

If column E of ap.xls matches with column A of leverage.xlsx then copy column E of leverage.xlsx and paste it to column Z of ap.xls

Before:
_____ Workbook: ap.xls ( Using Excel 2007 32 bit )

Row\Col	B	C	D	E	Z
1	AccountId	EntityName	Exchg-Seg	Symbol
2	WC5758		NSE	TCS
3	WC5758		NSE	SRTRANSFIN
4	WC5758		NSE	MARICO
5	WC5758		NSE	M&MFIN
6	WC5758		NSE	20MICRONS
7	WC5758		NSE	CONCOR
8	WC5758		NSE	COALINDIA
9	WC5758		NSE	BOSCHLTD
10	WC5758		NSE	BERGEPAINT
11	WC5758		NSE	5PAISA
12	WC5758		NSE	TATAELXSI
13	WC5758		NSE	HINDPETRO
14	WC5758		NSE	DISHTV
15

Worksheet: ap-Sheet1

_____ Workbook: LEVERAGE1.xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G
1	Stock Name			pro times	ultimate times
2	20MICRONS	EQ	INE144J01027	19	26	36.35
3	TCS	EQ	INE253B01015	19	26	13.5
4	3IINFOTECH	EQ	INE748C01020	29	39	2.05
5	3MINDIA	EQ	INE470A01017	48	64	21299
6	5PAISA	EQ	INE618L01018	31	41	129.5
7	63MOONS	EQ	INE111B01023	30	40	99.15
8	8KMILES	EQ	INE650K01021	27	36	56.5
9

Worksheet: Sheet1

If column E of ap.xls matches with column A of leverage.xlsx then copy column E of leverage.xlsx and paste it to column Z of ap.xls

After
example
cell E2 of ap.xls matches with column A3 of leverage.xlsx then copy E3 of leverage.xlsx and paste it to Z2 of ap.xls


_____ Workbook: ap.xls ( Using Excel 2007 32 bit )

Row\Col	B	C	D	E	Z
1	AccountId	EntityName	Exchg-Seg	Symbol
2	WC5758		NSE	TCS	25.823112
3	WC5758		NSE	SRTRANSFIN
4	WC5758		NSE	MARICO
5	WC5758		NSE	M&MFIN
6	WC5758		NSE	20MICRONS	25.823112
7	WC5758		NSE	CONCOR
8	WC5758		NSE	COALINDIA
9	WC5758		NSE	BOSCHLTD
10	WC5758		NSE	BERGEPAINT
11	WC5758		NSE	5PAISA	40.795512
12	WC5758		NSE	TATAELXSI
13	WC5758		NSE	HINDPETRO
14	WC5758		NSE	DISHTV

Worksheet: ap-Sheet1

For http://www.excelfox.com/forum/showth...ll=1#post11436

Before:
_____ Workbook: ap.xls ( Using Excel 2007 32 bit )

Row\Col	B	C	D	E	Z
1	AccountId	EntityName	Exchg-Seg	Symbol
2	WC5758		NSE	TCS
3	WC5758		NSE	SRTRANSFIN
4	WC5758		NSE	MARICO
5	WC5758		NSE	M&MFIN
6	WC5758		NSE	20MICRONS
7	WC5758		NSE	CONCOR
8	WC5758		NSE	COALINDIA
9	WC5758		NSE	BOSCHLTD
10	WC5758		NSE	BERGEPAINT
11	WC5758		NSE	5PAISA
12	WC5758		NSE	TATAELXSI
13	WC5758		NSE	HINDPETRO
14	WC5758		NSE	DISHTV

Worksheet: ap-Sheet1

_____ Workbook: LEVERAGE1.xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F
1	Stock Name			pro times	ultimate times
2	20MICRONS	EQ	INE144J01027	19	26	36.35
3	TCS	EQ	INE253B01015	19	26	13.5
4	3IINFOTECH	EQ	INE748C01020	29	39	2.05
5	3MINDIA	EQ	INE470A01017	48	64	21299
6	5PAISA	EQ	INE618L01018	31	41	129.5
7	63MOONS	EQ	INE111B01023	30	40	99.15
8	8KMILES	EQ	INE650K01021	27	36	56.5

Worksheet: Sheet1

After:
_____ Workbook: ap.xls ( Using Excel 2007 32 bit )

Row\Col	B	C	D	E	Z
1	AccountId	EntityName	Exchg-Seg	Symbol
2	WC5758		NSE	TCS	25.823112
3	WC5758		NSE	SRTRANSFIN
4	WC5758		NSE	MARICO
5	WC5758		NSE	M&MFIN
6	WC5758		NSE	20MICRONS	25.823112
7	WC5758		NSE	CONCOR
8	WC5758		NSE	COALINDIA
9	WC5758		NSE	BOSCHLTD
10	WC5758		NSE	BERGEPAINT
11	WC5758		NSE	5PAISA	40.795512
12	WC5758		NSE	TATAELXSI
13	WC5758		NSE	HINDPETRO
14	WC5758		NSE	DISHTV

Worksheet: ap-Sheet1

In support of this Thread:
http://www.excelfox.com/forum/showthread.php/2364-Delete-row
http://www.excelfox.com/forum/showth...364-Delete-row

_____ Workbook: BasketOrder..xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1	NSE	EQ	ACC	NA	NA	NA	0	1	0	BUY	MARKET	NA	CLI	MIS	DAY	WC5758	NA
2	NSE	EQ	ADANIPORTS	NA	NA	NA	0	1	0	SELL	MARKET	NA	CLI	MIS	DAY	WC5758	NA
3	NSE	EQ	AMBUJACEM	NA	NA	NA	0	1	0	BUY	MARKET	NA	CLI	MIS	DAY	WC5758	NA
4	NSE	EQ	ASIANPAINT	NA	NA	NA	0	1	0	BUY	MARKET	NA	CLI	MIS	DAY	WC5758	NA
5	NSE	EQ	AXISBANK	NA	NA	NA	0	1	0	BUY	MARKET	NA	CLI	MIS	DAY	WC5758	NA
6	NSE	EQ	BANKBARODA	NA	NA	NA	0	1	0	SELL	MARKET	NA	CLI	MIS	DAY	WC5758	NA
7

Worksheet: BasketOrder. (1)


_____ Workbook: 1.xls ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I
1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
2	NSE	ADANIPORTS	EQ	409	409	398.65	407.2	402
3	NSE	ABC	EQ	216.2	219.15	215.15	215.8	218
4	NSE	ASIANPAINT	EQ	1409	1441.95	1401.85	1404.2	1441.3
5	NSE	AXISBANK	EQ	732.9	739.3	728.15	727.45	733.65
6	NSE	BANKBARODA	EQ	118.8	119.15	114.7	118.35	115.25
7	NSE	BHARTIARTL	EQ	342.95	348.5	337.4	342.55	343.05
8

Worksheet: 1-Sheet1

---

The Process:
If cells of column C of basketorder.xlsx matches with cells of column B of 1.xlsx then delete the entire row of 1.xlsx(here entire row means the cells which matches delete that entire row)

_____ Workbook: BasketOrder..xlsx ( Using Excel 2007 32 bit )

NSE	EQ	ACC	NA	NA
NSE	EQ	ADANIPORTS	NA	NA
NSE	EQ	AMBUJACEM	NA	NA
NSE	EQ	ASIANPAINT	NA	NA
NSE	EQ	AXISBANK	NA	NA
NSE	EQ	BANKBARODA	NA	NA

Worksheet: BasketOrder. (1)

_____ Workbook: 1.xls ( Using Excel 2007 32 bit )

Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
NSE	ADANIPORTS	EQ	409	409	398.65	407.2	402
NSE	ABC	EQ	216.2	219.15	215.15	215.8	218
NSE	ASIANPAINT	EQ	1409	1441.95	1401.85	1404.2	1441.3
NSE	AXISBANK	EQ	732.9	739.3	728.15	727.45	733.65
NSE	BANKBARODA	EQ	118.8	119.15	114.7	118.35	115.25
NSE	BHARTIARTL	EQ	342.95	348.5	337.4	342.55	343.05

Worksheet: 1-Sheet1

Using data from last post

Before=
_____ Workbook: 1.xls ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I
1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
2	NSE	ADANIPORTS	EQ	409	409	398.65	407.2	402
3	NSE	ABC	EQ	216.2	219.15	215.15	215.8	218
4	NSE	ASIANPAINT	EQ	1409	1441.95	1401.85	1404.2	1441.3
5	NSE	AXISBANK	EQ	732.9	739.3	728.15	727.45	733.65
6	NSE	BANKBARODA	EQ	118.8	119.15	114.7	118.35	115.25
7	NSE	BHARTIARTL	EQ	342.95	348.5	337.4	342.55	343.05
8

Worksheet: 1-Sheet1

After=
_____ Workbook: 1.xls ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I
1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
2	NSE	ABC	EQ	216.2	219.15	215.15	215.8	218
3	NSE	BHARTIARTL	EQ	342.95	348.5	337.4	342.55	343.05
4

Worksheet: 1-Sheet1

Code:

---

'
Sub Vixer7() ' http://www.excelfox.com/forum/showthread.php/2364-Delete-row
Rem 1 Workbook and worksheets info
'1a) Workbook info
Dim Wbm As Workbook: Set Wbm = ThisWorkbook ' The workbook containing macro
Dim Wb1 As Workbook, Wb2 As Workbook ' (These will be set later when the workbooks are opened)
Dim strWb1 As String: Let strWb1 = "1.xls"
Dim strWb2 As String: Let strWb2 = "BasketOrder.xlsx" ' "BasketOrder..xlsx"
'1b) Worksheets info
Dim Ws1 As Worksheet, Ws2 As Worksheet ' (These will be set later when the workbooks are opened)
Dim Lr1 As Long, Lr2 As Long: Let Lr1 = 7: Lr2 = 6 ' For sample file
Rem 2 Open files  ..... we have to Open all the files all files are closed except the vba placed file
' Workbooks.Open Filename:="F:\Excel0202015Jan2016\ExcelFox\vixer\BasketOrder..xlsx"
 Workbooks.Open Filename:=ThisWorkbook.Path & "\" & strWb2
 Set Wb2 = ActiveWorkbook '
 Set Ws2 = Wb2.Worksheets.Item(1)
' Workbooks.Open Filename:="F:\Excel0202015Jan2016\ExcelFox\vixer\1.xls"
 Workbooks.Open Filename:=ThisWorkbook.Path & "\" & strWb1
 Set Wb1 = ActiveWorkbook ' The workbook just opened will now be the current active workbook
 Set Ws1 = Wb1.Worksheets.Item(1)
Rem 3 The Process ..."....If cells of column C of basketorder.xlsx matches with cells of column B of 1.xlsx then delete the entire row of 1.xlsx...."....
' 3a) Range.Find Method  range info
' 3a)(i) Search range ( range to be searched )
Dim rngSrch As Range: Set rngSrch = Ws2.Range("C1:C" & Lr2 & "") ' .."....column C of basketorder.xlsx
' 3a)(ii)' Data range, items to be searched for
Dim rngDta As Range: Set rngDta = Ws1.Range("B2:B" & Lr1 & "") '  .."....cells of column B of 1.xlsx
' 3b) MAIN LOOP for all cells in basketorder.xlsx
Dim Cnt As Long '_====================================MAIN LOOP===========================================
    For Cnt = Lr2 To 1 Step -1 ' data range to be searched for.... Important: I am going to delete rows in a loop: usually do such delete things in a backward loop. This is because I then effectively do a process on a cell or cells "behind me". So the process is done on a cell or cells no longer being considered. If I do the looping conventionally in the forward direction, then modification caused by the delete may effect the cells above, particularly their position. This can cause problems: After a delete, the cells above "move down". On the next loop I will then consider a cell above where I just was. So I will likely miss the next row to be considered, since that now occupies the position of the current loop. An alternative would be to loop forward, but after a delete to reduce the Loop count, Cnt, by 1. But changing the loop count variable in a loop is generally considered to be a bad idea    https://www.mrexcel.com/forum/excel-questions/803662-byte-backward-loop.html#post3929967
    Dim MtchedCel As Variant ' For the range object of a matched cell if found, if not found it will be  Nothing  , so we must use a variant to allow for the type of  Range  or  Nothing
    Set MtchedCel = rngSrch.Find(What:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, Lookat:=xlWhole, Searchdirection:=xlNext, MatchCase:=True) ' rngDta.Item(Cnt) will be a cell of column C of basketorder.xlsx
        If Not MtchedCel Is Nothing Then ' If  cell of column C of basketorder.xlsx matches with cells of column B of 1.xlsx  Then .....
        rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp ' ..... delete the entire row of 1.xlsx
        Else
        End If
       
    Next Cnt '_====================================MAIN LOOP===============================================
Rem 4  ...."... after the process close and save the file so that changes should be saved
 Wb1.Close savechanges:=True
End Sub

---

Extra notes in support of this Thread:
http://www.excelfox.com/forum/showth...364-Delete-row
http://www.excelfox.com/forum/showth...ll=1#post11463
http://www.excelfox.com/forum/showthread.php/2364-Delete-row

---

---

Making Lr dynamic

( using rng.End(XlUp) for a single column. )

For example, from http://www.excelfox.com/forum/showth...364-Delete-row :
BasketOrder.xlsx for column C, Lr is 6
( BasketOrder.xlsx : https://app.box.com/s/v4b19po7jtjmh7wcswykbij3y896dv05
)
_____ Workbook: BasketOrder.xlsx ( Using Excel 2007 32 bit )

Row\Col	B	C	D
1	EQ	ACC	NA
2	EQ	ADANIPORTS	NA
3	EQ	AMBUJACEM	NA
4	EQ	ASIANPAINT	NA
5	EQ	AXISBANK	NA
6	EQ	BANKBARODA	NA
7

Worksheet: BasketOrder. (1)

Lr2, for column C is :
Ws2.Range("C" & Ws2.Rows.Count).End(xlUp).Row
or
Ws2.Cells.Item(Ws2.Rows.Count, 3).End(xlUp).Row
or
Ws2.Cells.Item(Ws2.Rows.Count, "C").End(xlUp).Row

To explain:
'_- 1 :- Rows.Count Property of a worksheet
Ws2.Range("C" & Ws2.Rows.Count)
or
Ws2.Cells.Item(Ws2.Rows.Count, 3)
or
Ws2.Cells.Item(Ws2.Rows.Count, "C")

For Excel 2007 and higher versions ( .xlsx .xlsm ), this is 1048576 rows in a worksheet ( ImmediateWindow RowsCount XL 2007.JPG : https://imgur.com/NHHdylV )
Ws2.Range("C" & 1048576)
or
Ws2.Cells.Item(1048576, 3)
or
Ws2.Cells.Item(1048576, "C")
This is the last cell in column C:
_____ Workbook: BasketOrder.xlsx ( Using Excel 2007 32 bit )

Row\Col	B	C	D
1048574
1048575
1048576

Worksheet: BasketOrder. (1)

So we are at the bottom of the worksheet….

'_- 2 :- .End(xlUp) Property action
This is the same as keyboard keys _ Ctrl+UpArrow
Ctrl + UpArrow.JPG : https://imgur.com/w5w8KxZ

….This action will take you back up to the next filled cell:
_End(XlUp).JPG : https://imgur.com/JQJxc1s

….So we are at the last filled cell in column C

'_- 3 :- .Row Property
This will give you the row number of the cell
_Row.JPG : https://imgur.com/bMpaBOv

---

For example, from http://www.excelfox.com/forum/showth...364-Delete-row :
1.xls for column B, Lr is 7
( 1.xls : https://app.box.com/s/beqlzzl3nwjff2ocyz4ox8twu5jnqd6e )
_____ Workbook: 1.xls ( Using Excel 2007 32 bit )

Row\Col	A	B	C
1	Exchange	Symbol	Series/Expiry
2	NSE	ADANIPORTS	EQ
3	NSE	ABC	EQ
4	NSE	ASIANPAINT	EQ
5	NSE	AXISBANK	EQ
6	NSE	BANKBARODA	EQ
7	NSE	BHARTIARTL	EQ
8

Worksheet: 1-Sheet1

Lr1, for column B is :
Ws1.Range("B" & Ws1.Rows.Count).End(xlUp).Row
or
Ws1.Cells.Item(Ws1.Rows.Count, 2).End(xlUp).Row
or
Ws1.Cells.Item(Ws1.Rows.Count, "B").End(xlUp).Row

To explain:
'_- 1 :- Rows.Count Property of a worksheet
Ws1.Range("B" & Ws1.Rows.Count)
or
Ws1.Cells.Item(Ws1.Rows.Count, 2)
or
Ws1.Cells.Item(Ws1.Rows.Count, "B")

For Excel 97 - 2003 ( .xls ), this is 65536 rows in a worksheet ( ImmediateWindow RowsCount XL 2003.JPG : https://imgur.com/iOmrf9n )
Ws1.Range("B" & 65536 ))
or
Ws1.Cells.Item( 65536 , 2)
or
Ws1.Cells.Item( 65536 , "B")

This is the last cell in column B:
(Last Worksheet Row in XL 2003.JPG : https://imgur.com/iaEPoZG )
Attachment 2401
_____ Workbook: 1.xls ( Using Excel 2007 32 bit )

Row\Col	A	B	C
65533
65534
65535
65536

Worksheet: 1-Sheet1

So we are at the bottom of the worksheet …

'_- 2 :- .End(xlUp) Property action
This is the same as keyboard keys _ Ctrl+UpArrow
Ctrl + UpArrow.JPG : https://imgur.com/w5w8KxZ
Attachment 2402

…This action will take you back up to the next filled cell:
_End(XlUp) XL2003.JPG : https://imgur.com/JYPd95V
Attachment 2403

….So we are at the last filled cell in column B

'_- 3 :- .Row Property
This will give you the row number of the cell
_ Row.JPG : https://imgur.com/ZWCFvmr
Attachment 2404

---

Example Demo
For uploaded files..
BasketOrder.xlsx : https://app.box.com/s/v4b19po7jtjmh7wcswykbij3y896dv05
1.xls : https://app.box.com/s/beqlzzl3nwjff2ocyz4ox8twu5jnqd6e
run this macro

Code:

---

Sub Vixer8_MakingLrDynamic() ' http://www.excelfox.com/forum/showthread.php/2364-Delete-row?p=11463&viewfull=1#post11463
'
Rem 1 Workbook and worksheets info
'1a) Workbook info
Dim Wbm As Workbook: Set Wbm = ThisWorkbook ' The workbook containing macro
Dim Wb1 As Workbook, Wb2 As Workbook ' (These will be set later when the workbooks are opened)
Dim strWb1 As String: Let strWb1 = "1.xls"                            '      --- 1.xls      :      https://app.box.com/s/beqlzzl3nwjff2ocyz4ox8twu5jnqd6e
Dim strWb2 As String: Let strWb2 = "BasketOrder.xlsx" ' "BasketOrder..xlsx"  --- BasketOrder.xlsx : https://app.box.com/s/v4b19po7jtjmh7wcswykbij3y896dv05
'1b) Worksheets info
Dim Ws1 As Worksheet, Ws2 As Worksheet ' (These will be set later when the workbooks are opened)
'                Dim Lr1 As Long, Lr2 As Long ' To be determined from files                                                                            : Let Lr1 = 7: Lr2 = 6 ' For sample files
Rem 2 Open files  ..... we have to Open all the files all files are closed except the vba placed file
' Workbooks.Open Filename:="F:\Excel0202015Jan2016\ExcelFox\vixer\BasketOrder..xlsx"
 Workbooks.Open Filename:=ThisWorkbook.Path & "\" & strWb2
 Set Wb2 = ActiveWorkbook '
 Set Ws2 = Wb2.Worksheets.Item(1)
' Workbooks.Open Filename:="F:\Excel0202015Jan2016\ExcelFox\vixer\1.xls"
 Workbooks.Open Filename:=ThisWorkbook.Path & "\" & strWb1
 Set Wb1 = ActiveWorkbook ' The workbook just opened will now be the current active workbook
 Set Ws1 = Wb1.Worksheets.Item(1)



Rem 3 making Lr dynamic
Dim Lr2 As Long
 Let Lr2 = Ws2.Range("C" & Ws2.Rows.Count).End(xlUp).Row
 Let Lr2 = Ws2.Cells.Item(Ws2.Rows.Count, 3).End(xlUp).Row
 Let Lr2 = Ws2.Cells.Item(Ws2.Rows.Count, "C").End(xlUp).Row
Dim Lr1 As Long
 Let Lr1 = Ws1.Range("B" & Ws1.Rows.Count).End(xlUp).Row
 Let Lr1 = Ws1.Cells.Item(Ws1.Rows.Count, 2).End(xlUp).Row
 Let Lr1 = Ws1.Cells.Item(Ws1.Rows.Count, "B").End(xlUp).Row

'3b) demo
 Ws2.Activate
 MsgBox prompt:="Lr in worksheet " & Ws2.Name & ", in workbook " & Wb2.Name & " is  " & Lr2 & vbCrLf & "(last row in worksheet is  " & Ws2.Rows.Count & ")"
 Ws1.Activate
 MsgBox prompt:="Lr in worksheet " & Ws1.Name & ", in workbook " & Wb1.Name & " is  " & Lr1 & vbCrLf & "(last row in worksheet is  " & Ws1.Rows.Count & ")"

Rem 4 close files
Wb2.Close: Wb1.Close
End Sub

---

---

Ref:
https://www.excelforum.com/hello-int...ess-forum.html
http://www.excelfox.com/forum/showth...ll=1#post10192
http://www.excelfox.com/forum/showth...1466#post11466

---

BasketOrder.xlsx : https://app.box.com/s/v4b19po7jtjmh7wcswykbij3y896dv05
1.xls : https://app.box.com/s/beqlzzl3nwjff2ocyz4ox8twu5jnqd6e

in support of this Thread:
http://www.excelfox.com/forum/showth...1472#post11472
https://www.mrexcel.com/forum/excel-...ation-vba.html
http://www.vbaexpress.com/forum/show...Formula-by-vba
http://www.excelforum.com/excel-prog...on-by-vba.html




_____ Workbook: 124.xlsb ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F
1	Symbol	LTP			1st row contains headers so ignore the first row
2	ACC	1587.95	50	1333.878	Column D is the result that I need by vba
3	ADANIPORTS	402	70	337.68	I don't want formulas I need only the result in column D
4	AMBUJACEM	218	20	183.12
5	ASIANPAINT	1441.3	10	1210.692
6	AXISBANK	733.65	5	616.266
7	BANKBARODA	115.25	7	96.81
8	BHARTIARTL	343.05	8	288.162
9	BOSCHLTD	15150	19	12726
10	BPCL	359	350	301.56
11
12					Multiply the value of B2 by 1.5%, then multiply that result by 56 and then paste the result in D2
13					1333.878
14

Worksheet: Sheet1

_____ Workbook: sample.xlsx ( Using Excel 2007 32 bit )

Row\Col	E
12	Multiply the value of B2 by 1.5%, then multiply that result by 56 and then paste the result in D2
13	=B2*(1.5/100)*56

Worksheet: Sheet1

---

Before
_____ Workbook: 124.xlsb ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D
2	ACC	1587.95	50
3	ADANIPORTS	402	70
4	AMBUJACEM	218	20
5	ASIANPAINT	1441.3	10
6	AXISBANK	733.65	5
7	BANKBARODA	115.25	7
8	BHARTIARTL	343.05	8
9	BOSCHLTD	15150	19
10	BPCL	359	350

Worksheet: Sheet1

After
_____ Workbook: 124.xlsb ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D
2	ACC	1587.95	50	1333.878
3	ADANIPORTS	402	70	337.68
4	AMBUJACEM	218	20	183.12
5	ASIANPAINT	1441.3	10	1210.692
6	AXISBANK	733.65	5	616.266
7	BANKBARODA	115.25	7	96.81
8	BHARTIARTL	343.05	8	288.162
9	BOSCHLTD	15150	19	12726
10	BPCL	359	350	301.56

Worksheet: Sheet1

In support of this Thread:
http://www.excelfox.com/forum/showthread.php/2369-Calculation-by-vba?p=11472&viewfull=1#post11472
http://www.excelfox.com/forum/showth...ll=1#post11472

Quote:

---

Originally Posted by sumanjjj

i have data upto 100 or 200 rows it can be more all it depends i have to do the same process till the end of the data

---

So we need to make Lr dynamic, for example
sample.xlsx
_____ Workbook: sample.xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D
1	Symbol	LTP
2	ACC	1587.95	50
3	ADANIPORTS	402	70
4	AMBUJACEM	218	20
5	ASIANPAINT	1441.3	10
6	AXISBANK	733.65	5
7	BANKBARODA	115.25	7
8	BHARTIARTL	343.05	8
9	BOSCHLTD	15150	19
10	BPCL	359	350
11

Worksheet: Sheet1

Code:

---

'
Sub Vixer8b_MakingLrDynamic() ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11474&viewfull=1#post11474
'
Rem 1 Workbook and worksheets info
'1a) Workbook info
Dim Wbm As Workbook: Set Wbm = ThisWorkbook ' The workbook containing macro
Dim Wb1 As Workbook ' (This will be set later when the workbooks are opened)
Dim strWb1 As String: Let strWb1 = "sample.xlsx"
'1b) Worksheets info
Dim Ws1 As Worksheet ' (This will be set later when the workbooks are opened)
'                Dim Lr1 As Long, Lr2 As Long ' To be determined from files                                                                            : Let Lr1 = 7: Lr2 = 6 ' For sample files
Rem 2 Open file  .....
 Workbooks.Open Filename:=ThisWorkbook.Path & "\" & strWb1
 Set Wb1 = ActiveWorkbook ' The workbook just opened will now be the current active workbook
 Set Ws1 = Wb1.Worksheets.Item(1)



Rem 3 making Lr dynamic
Dim Lr1 As Long
 Let Lr1 = Ws1.Range("C" & Ws1.Rows.Count).End(xlUp).Row
 Let Lr1 = Ws1.Cells.Item(Ws1.Rows.Count, 3).End(xlUp).Row
 Let Lr1 = Ws1.Cells.Item(Ws1.Rows.Count, "C").End(xlUp).Row

'3b)(i) demo (i)
 Ws1.Activate
 MsgBox prompt:="Lr in worksheet " & Ws1.Name & ", in workbook " & Wb1.Name & " is  " & Lr1 & vbCrLf & "(last row in worksheet is  " & Ws1.Rows.Count & ")"

'3b)(ii) demo (ii)
 Ws1.Range("C" & Ws1.Rows.Count).Select ' select last cell in column C
 Application.Wait (Now + TimeValue("0:00:03"))  '  VBA wait 3 seconds    https://docs.microsoft.com/de-de/office/vba/api/excel.application.wait

 ActiveCell.End(xlUp).Select            ' go back up to last used cell in column C
 Application.Wait (Now + TimeValue("0:00:06"))  '  VBA wait 6 seconds

Rem 4 close file
 Wb1.Close
End Sub

---

---

Code:

---

Rem 3 making Lr dynamic
Dim Lr1 As Long
 Let Lr1 = Ws1.Range("C" & Ws1.Rows.Count).End(xlUp).Row
 Let Lr1 = Ws1.Cells.Item(Ws1.Rows.Count, 3).End(xlUp).Row
 Let Lr1 = Ws1.Cells.Item(Ws1.Rows.Count, "C").End(xlUp).Row

---

To explain:-

_ Rows.Count
Ws1.Range("C" & Ws1.Rows.Count)
Or
Ws1.Cells.Item(Ws1.Rows.Count, 3)
Or
Ws1.Cells.Item(Ws1.Rows.Count, "C")

We are in a .xlsx file, so Rows.Count is 1048576
Ws1.Range("C" & 1048576)
or
Ws1.Cells.Item(1048576, 3)
or
Ws1.Cells.Item(1048576, "C")

This is the last cell in column C:
Last cell in Column C in worksheet Sheet1 in workbook sample xlsx.JPG : https://imgur.com/HH9UKki
Attachment 2413
_____ Workbook: sample.xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D
1048574
1048575
1048576

Worksheet: Sheet1

So we are at the bottom of the worksheet…..

_ .End(XlUp) Property action
This is the same as keyboard keys _ Ctrl+UpArrow
Ctrl + UpArrow.JPG : https://imgur.com/w5w8KxZ
Attachment 2402

…This action will take you back up to the next filled cell:
_End(XlUp) in column C from last cell in worksheet Sheet1 in workbook sample xlsx : https://imgur.com/fIDDbYB
Attachment 2411

…so we are at the last cell in column C that is filled with something

_ .Row Property
This will return the row number or the cell to which it is applied.
_Row for current active cell.JPG : https://imgur.com/uKVAIgN
Attachment 2412

Some further notes and information for this Thread:
http://www.excelfox.com/forum/showth...1476#post11476
http://www.excelfox.com/forum/showth...ulation-by-vba
https://www.mrexcel.com/forum/excel-...ation-vba.html
http://www.vbaexpress.com/forum/show...Formula-by-vba
https://www.excelforum.com/excel-pro...on-by-vba.html


There are many different was to achieve the same…
Some further notes on changes that can be made to Sub Vixer9a() from here: http://www.excelfox.com/forum/showth...ll=1#post11475

---

b) Rng.Value = Rng.Value

Excel VBA has been written such that applying .Value to a cell or cells has a similar effect to writing manually into a cell.

So if you do this:
Range("A1").Value = "X"
, it will write
X
in the first cell.
You will then see in the first cell this
X

If you do this:
Range("A1").Value = " = 1"
, it will write
= 1
in the first cell.
But, you will see in the first cell just the Value:
1

To explain:
The .Value Property of a range object , for example a single cell, is what we "see" in the cell. But if you apply .Value to a cell it will write into the cell as if you did it manually.

So, in your code you can replace this: …_

Code:

---

'3(iii) I need only result in the cell no formulas
 Ws1.Range("D2:D" & Lr1 & "").Copy
 Ws1.Range("D2:D" & Lr1 & "").PasteSpecial Paste:=xlPasteValues
 Let Application.CutCopyMode = False

---

_.. with this:

Code:

---

'3(iii) I need only result in the cell no formulas
 Let Ws1.Range("D2:D" & Lr1 & "").Value = Ws1.Range("D2:D" & Lr1 & "").Value

---

Code:

---

Sub Vixer9b() ' demo for  rng.Value = rng.Value
Rem 1 Workbook and worksheets info
'1a) Workbook info
' Dim Wbm As Workbook: Set Wbm = ThisWorkbook ' The workbook containing macro
Dim Wb1 As Workbook ' This will be set later when the workbook is opened
Dim MyPath As String: Let MyPath = "C:\Users\sk\Desktop" '  ".....The file will be located in C:\Users\sk\Desktop ....
Dim strWb1 As String: Let strWb1 = "sample.xlsx" '                                                          " ....and file name is sample.xlsx
'1b) Worksheets info
Dim Ws1 As Worksheet ' This will be set later when the workbook is opened)
Dim Lr1 As Long '      Let Lr1 = 10 for sample file  , but we will determine it dynamically after opening the file
Rem 2 Open file  "..... file is not opened so we have to open the file by vba
' Workbooks.Open Filename:="F:\Excel0202015Jan2016\ExcelFox\vixer\sample.xlsx"
 Workbooks.Open Filename:=ThisWorkbook.Path & "\" & strWb1  '  ...both files are located in same place
' Workbooks.Open Filename:=MyPath & "\" & strWb1              '  ...file will be located in C:\Users\sk\Desktop
 Set Wb1 = ActiveWorkbook ' The workbook just opened will now be the current active workbook
 Set Ws1 = Wb1.Worksheets.Item(1)

' make Lr1 dynamic .... http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11474&viewfull=1#post11474
 Let Lr1 = Ws1.Range("C" & Ws1.Rows.Count).End(xlUp).Row
Rem 3 The Process ..."....
'3(i) ....Multiply the value of B2 by 1.5%, then multiply that result by 56 and then paste the result in D2.. formula will be added by me in the code, put that formula in
 Ws1.Range("D2").Value = "=B2*(1.5/100)*56"
'3(ii) ....drag it
 Ws1.Range("D2").AutoFill Destination:=Ws1.Range("D2:D" & Lr1 & ""), Type:=xlFillDefault
'3(iii) I need only result in the cell no formulas
 Let Ws1.Range("D2:D" & Lr1 & "").Value = Ws1.Range("D2:D" & Lr1 & "").Value
Rem 4 save it and close it
 Wb1.Save
 Wb1.Close
End Sub

---

---

_c) Apply "fixed vector"** form across a range

I can apply the formula in its "fixed vector"** form across a range. In other words I can apply the same formula in its fixed vector form across a range. Applying the same fixed vector formula across a range will make any referred to cells change the shown formula appropriately to apply to the different cells

** In simplified terms, "fixed vector", means notation without the $. So..
A1 is "fixed vector"
$A$1 is absolute referencing

So we can replace this:

Code:

---

'3(i) ....Multiply the value of B2 by 1.5%, then multiply that result by 56 and then paste the result in D2.. formula will be added by me in the code, put that formula in
 Ws1.Range("D2").Value = "=B2*(1.5/100)*56"
'3(ii) ....drag it
 Ws1.Range("D2").AutoFill Destination:=Ws1.Range("D2:D" & Lr1 & ""), Type:=xlFillDefault

---

With this:

Code:

---

'3(i)(ii) ....Multiply the value of B2 by 1.5%, then multiply that result by 56 and then paste the result in D2..  ....drag it formula will be added by me in the code, put that formula in
 Ws1.Range("D2:D" & Lr1 & "").Value = "=B2*(1.5/100)*56"

---

Code:

---

Sub Vixer9c() ' demo for  fixed vector applied across a range
Rem 1 Workbook and worksheets info
'1a) Workbook info
' Dim Wbm As Workbook: Set Wbm = ThisWorkbook ' The workbook containing macro
Dim Wb1 As Workbook ' This will be set later when the workbook is opened
Dim MyPath As String: Let MyPath = "C:\Users\sk\Desktop" '  ".....The file will be located in C:\Users\sk\Desktop ....
Dim strWb1 As String: Let strWb1 = "sample.xlsx" '                                                          " ....and file name is sample.xlsx
'1b) Worksheets info
Dim Ws1 As Worksheet ' This will be set later when the workbook is opened)
Dim Lr1 As Long '      Let Lr1 = 10 for sample file  , but we will determine it dynamically after opening the file
Rem 2 Open file  "..... file is not opened so we have to open the file by vba
' Workbooks.Open Filename:="F:\Excel0202015Jan2016\ExcelFox\vixer\sample.xlsx"
 Workbooks.Open Filename:=ThisWorkbook.Path & "\" & strWb1  '  ...both files are located in same place
' Workbooks.Open Filename:=MyPath & "\" & strWb1              '  ...file will be located in C:\Users\sk\Desktop
 Set Wb1 = ActiveWorkbook ' The workbook just opened will now be the current active workbook
 Set Ws1 = Wb1.Worksheets.Item(1)

' make Lr1 dynamic .... http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11474&viewfull=1#post11474
 Let Lr1 = Ws1.Range("C" & Ws1.Rows.Count).End(xlUp).Row
Rem 3 The Process ..."....
'3(i)(ii) ....Multiply the value of B2 by 1.5%, then multiply that result by 56 and then paste the result in D2..  ....drag it formula will be added by me in the code, put that formula in
 Ws1.Range("D2:D" & Lr1 & "").Value = "=B2*(1.5/100)*56"
'3(iii) I need only result in the cell no formulas
 Let Ws1.Range("D2:D" & Lr1 & "").Value = Ws1.Range("D2:D" & Lr1 & "").Value
Rem 4 save it and close it
 Wb1.Save
 Wb1.Close
End Sub

---

---

_d) Internal calculation with VBA arrays
We do not need to put formulas into any cells.
We can do the calculations internally, within coding, and then paste all the values out in one go.
Using VBA arrays is a convenient way to do this.

_a) First we bring all the data into an array.
_b) Then we do the calculations
_c) Finally we paste out all the calculated values in one go

We can replace all of Rem3 with new coding
Rem 3 The Process .. using VBA arrays
'3_a) First we bring all the data into an array.
'3_b) Now we do the calculations
'3_c) Finally we paste out all the calculated values in one go

Code:

---

Rem 3 The Process ...using VBA arrays
'3_a) First we bring all the data into an array. (We also take in the column D values, even if the column D is empty)
Dim arrDta() As Variant
 Let arrDta() = Ws1.Range("A1:D" & Lr1 & "").Value
'3_b) Now we do the calculations looping through the row data held internally in the data array, arrDta()
Dim Cnt As Long
    For Cnt = 2 To Lr1
    Let arrDta(Cnt, 4) = arrDta(Cnt, 2) * (1.5 / 100) * 56 ' .. like.. column "D" = column "B" * (1.5/100) * 56
    Next Cnt
'3_c) Finally we paste out all the calculated values ( and also the original data )  in one go
 Ws1.Range("A1:D" & Lr1 & "").Value = arrDta()

---

Code:

---

Sub Vixer9d() ' demo using VBA arrays
Rem 1 Workbook and worksheets info
'1a) Workbook info
' Dim Wbm As Workbook: Set Wbm = ThisWorkbook ' The workbook containing macro
Dim Wb1 As Workbook ' This will be set later when the workbook is opened
Dim MyPath As String: Let MyPath = "C:\Users\sk\Desktop" '  ".....The file will be located in C:\Users\sk\Desktop ....
Dim strWb1 As String: Let strWb1 = "sample.xlsx" '                                                          " ....and file name is sample.xlsx
'1b) Worksheets info
Dim Ws1 As Worksheet ' This will be set later when the workbook is opened)
Dim Lr1 As Long '      Let Lr1 = 10 for sample file  , but we will determine it dynamically after opening the file
Rem 2 Open file  "..... file is not opened so we have to open the file by vba
' Workbooks.Open Filename:="F:\Excel0202015Jan2016\ExcelFox\vixer\sample.xlsx"
 Workbooks.Open Filename:=ThisWorkbook.Path & "\" & strWb1  '  ...both files are located in same place
' Workbooks.Open Filename:=MyPath & "\" & strWb1              '  ...file will be located in C:\Users\sk\Desktop
 Set Wb1 = ActiveWorkbook ' The workbook just opened will now be the current active workbook
 Set Ws1 = Wb1.Worksheets.Item(1)

' make Lr1 dynamic .... http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11474&viewfull=1#post11474
 Let Lr1 = Ws1.Range("C" & Ws1.Rows.Count).End(xlUp).Row
Rem 3 The Process ...using VBA arrays
'3_a) First we bring all the data into an array. (We also take in the column D values, even if the column D is empty)
Dim arrDta() As Variant
 Let arrDta() = Ws1.Range("A1:D" & Lr1 & "").Value
'3_b) Now we do the calculations looping through the row data held internally in the data array, arrDta()
Dim Cnt As Long
    For Cnt = 2 To Lr1
    Let arrDta(Cnt, 4) = arrDta(Cnt, 2) * (1.5 / 100) * 56 ' .. like.. column "D" = column "B" * (1.5/100) * 56
    Next Cnt
'3_c) Finally we paste out all the calculated values ( and also the original data )  in one go
 Ws1.Range("A1:D" & Lr1 & "").Value = arrDta()
Rem 4 save it and close it
 Wb1.Save
 Wb1.Close
End Sub

---

---

_e) Evaluate Range
see next post:

_e) Evaluate Range

It is possible to get array type calculations in Excel. Nobody fully understands this topic, and a lot of things are found by chance to work in a way such as to do array type calculations, or rather , array type results can be obtained.

Evaluate Range techniques often allow a looping process to be replaced ba a single line of code. Broadly this arises due to two things:
_1) Excel frequently updates all cells in a spreadsheet by going across the columns in a row , then down a row, then across the columns in the next row … etc.
Usually a user "using" a single cell is like when it selected, and/ or the carriage Return key is used, and so it appears to us as if the cell is Updated and displayed at one time. There are various ways to display more than one cell in a single spreadsheet update.
_2) In VBA there is an Evaluate Method ( https://docs.microsoft.com/en-us/off...ation.evaluate ). In simplified terms, this allows calculation within VBA as if the calculations were written and done in a spreadsheet.

It is possible sometimes to get the Evaluate function to return an array representing the calculations across a range
There is no clear documentation on any of the array type things discussed in this post, and it is often suggested that getting array results in any form in Excel has occurred by chance and no one understands fully what is going on.


As an example, considering the last macro which looped to produce an array based on doing these calculations of this form, from down rows of 2 to Lr1
B2*(1.5/100)*56
B3*(1.5/100)*56
B4*(1.5/100)*56
_…. etc.

We find that Rem 3 from the last macro, Sub Vixer9d() , can be replaced by

Code:

---

Rem 3 The Process ...  using Evaluate Range
 Ws1.Range("D2:D" & Lr1 & "").Value = Ws1.Evaluate("=" & Range("B2:B" & Lr1 & "").Address & "*(1.5/100)*56")

---

The purpose of ("=" & Range("B2:B" & Lr1 & "") is to give us the formula form of like
=B2:B10
Hence the Range used does not need to be Qualified, such as by a worksheet, like in Ws1.Range
( There is an alternative form of Evaluate(" __ ") , which is often referred to as the "shorthand form" of Evaluate(" __ ") . It looks like this _ [ ___ ] _ . So you may now see what Mark L was suggesting here: https://www.excelforum.com/excel-pro...ml#post5190685 )

It is , however , important to qualify Evaluate. this is because we want to do an evaluation as if the formula within Evaluate(" ___ ") , was in the cell in worksheet, Ws1. If we omit the qualifying _ Ws1. _ , before the Evaluate , then we may do an evaluation of the formula in a different worksheet.

Code:

---

Sub Vixer9e() ' demo  for  Evaluate Range
Rem 1 Workbook and worksheets info
'1a) Workbook info
' Dim Wbm As Workbook: Set Wbm = ThisWorkbook ' The workbook containing macro
Dim Wb1 As Workbook ' This will be set later when the workbook is opened
Dim MyPath As String: Let MyPath = "C:\Users\sk\Desktop" '  ".....The file will be located in C:\Users\sk\Desktop ....
Dim strWb1 As String: Let strWb1 = "sample.xlsx" '                                                          " ....and file name is sample.xlsx
'1b) Worksheets info
Dim Ws1 As Worksheet ' This will be set later when the workbook is opened)
Dim Lr1 As Long '      Let Lr1 = 10 for sample file  , but we will determine it dynamically after opening the file
Rem 2 Open file  "..... file is not opened so we have to open the file by vba
' Workbooks.Open Filename:="F:\Excel0202015Jan2016\ExcelFox\vixer\sample.xlsx"
 Workbooks.Open Filename:=ThisWorkbook.Path & "\" & strWb1  '  ...both files are located in same place
' Workbooks.Open Filename:=MyPath & "\" & strWb1              '  ...file will be located in C:\Users\sk\Desktop
 Set Wb1 = ActiveWorkbook ' The workbook just opened will now be the current active workbook
 Set Ws1 = Wb1.Worksheets.Item(1)

' make Lr1 dynamic .... http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11474&viewfull=1#post11474
 Let Lr1 = Ws1.Range("C" & Ws1.Rows.Count).End(xlUp).Row
Rem 3 The Process ...  using Evaluate Range
 Ws1.Range("D2:D" & Lr1 & "").Value = Ws1.Evaluate("=" & Range("B2:B" & Lr1 & "").Address & "*(1.5/100)*56")
Rem 4 save it and close it
 Wb1.Save
 Wb1.Close
End Sub

---

---

Using Evaluate often results in a much shorter coding.

For example, taking Sub Vixer9e() , and making a few other simplifications we can come up with a much shorter coding.

Code:

---

Sub Vixer9f() ' simplified coding ( using Range Evaluate )
 Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "sample.xlsx"  '  ...both files are located in same place
Rem 3 The Process ...  using Evaluate Range
 ActiveSheet.Range("D2:D" & ActiveSheet.Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row & "").Value = ActiveSheet.Evaluate("=" & Range("B2:B" & ActiveSheet.Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row & "").Address & "*(1.5/100)*56")
Rem 4 save it and close it
 ActiveWorkbook.Close savechanges:=True
End Sub

---

I personally do not like such coding because
_(i) They are more difficult to understand, especially at a later date,
_(ii) They are less flexible for adjustment.
_(iii) There may be some missing detail which might cause the coding to fail sometimes in certain circumstances

in support of this post:
https://excel.tips.net/T001940_Hidin...ell_Value.html
https://excel.tips.net/T001940_Hiding_Rows_Based_on_a_Cell_Value.html


Hello Ryanne
Rather than modifying the coding, it would probably be easier to use a simple "events" type coding which automatically kicks in when a range value is changed in a worksheet. Something of this form:.

Code:

---

Private Sub Worksheet_Change(ByVal Target As Range)
 Target.EntireRow.Hidden = True
End Sub


































'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
'End Sub

---

This coding will need to be in a worksheet code module.
Follow , for example these 6 steps to create such a coding:

_1) Right click on the tab of the worksheet of interest
_2) Select View Code
Worksheet code module via View Code after right click on tab.JPG : : https://imgur.com/ZiOuRVT
Attachment 2426

_3) Select the left side drop down list
_4) Select Worksheet
Worksheet.JPG : https://imgur.com/tCwHKBo
Attachment 2427

_5) Select the right drop down list
_6) Select Change
Change.JPG : https://imgur.com/NkbNPsL
Attachment 2428

( Delete or ' comment out any other coding, such as the Private Sub Worksheet_SelectionChange which may have appeared automatically at step 4 )



You can now add your coding within the Private Sub Worksheet_Change


( Hit Alt+F11 to return to spreadsheet view )

The coding will kick off automatically when you change any cell value. It will hide the entire row which contains the cell whose value you changed


In the uploaded file , I have added the coding to the third worksheet code module

Alan

Some supporting notes for some other stuff...



_3) Regarding the remaining leftover hide.me app on Windows 7 machine after I de- installed it
….( hide.me that was still showing in my program list after I had de installed, and note also that on restarting the windows 7 machine with the remaining left over hideme app, a hideme typically window came up , did something for a while, then another hide me window came up and offered me the chance to buy premium!! )
Strange remaining hide me thing after de install.JPG : https://imgur.com/4HsLmDN
Attachment 2439

I tried the Revo Unistaller as suggested, http://revo-uninstaller.en.softonic.com/ .
This was also not able to de install the hide.me that was still showing in my program list after I had de installed it: Revo also cannot de install the remaining hide.me.jpghttps://imgur.com/HY7pSIy
After this failed attempt, I performed the scan that Revo offered.
This scan took several hours. The scan first showed these left over registry things, Revo scan found left over hideme.jpg : https://imgur.com/r99WKN6
Attachment 2440
, which I chose to delete: Choose to delete found left over hideme.jpg , Deleting scan found left over hideme.jpg : https://imgur.com/aoToZJ2 , https://imgur.com/5jsACjQ .
Then the following left over files and folders were also shown, Revo scan found left over hideme Files and Folders.jpg : https://imgur.com/78YKmd4
Attachment 2441
, which I also chose to delete: Choose to delete Revo scan found left over hideme Files and Folders.jpg , Deletingf Revo scan found left over hideme Files and Folders.jpg : https://imgur.com/VAlBzED , https://imgur.com/2YoSSML .
Finally it appears that all left over hide.me files are gone: hideme no longer listed in programs.jpg : https://imgur.com/9aentWL
A restart is said to remove some files, .. Revo says remainig files will be deleted by restart.jpg : https://imgur.com/QTjDtf1 , so I restarted.
It seemed at this stage, ( after a restart) that the hideme app was completely removed.

In support of answers to these Threads:
http://www.excelfox.com/forum/showth...ified-email-id
https://stackoverflow.com/questions/...75857_58525487
https://stackoverflow.com/questions/...-be-sent-to-sm
https://stackoverflow.com/questions/...-less-and-less

Register an account with Freemail German Telekom, for use with CDO.Message Send program

Login / Register
https://www.t-online.de/
Login.JPG : https://imgur.com/n5aLakd
https://accounts.login.idm.telekom.c...nse_type=code#
ht[color==#417394]tps://accounts.login.idm.telekom.com/oauth2/auth?client_id=10LIVESAM30000004901PORTAL000000000 00000&state=d725154dc1fc296807eda1341546636892fc97 39ccb75d714dc2c89b4159148e&claims=%7B%22id_token%2 2%3A%7B%22urn%3Atelekom.com%3Aall%22%3Anull%7D%7D& nonce=d725154dc1fc296807eda1341546636892fc9739ccb7 5d714dc2c89b4159148e&redirect_uri=https%3A%2F%2Flo gin.t-online.de%2Fcallback&display=popup&scope=openid&re sponse_type=code#[/color]
Registrieren.JPG : https://imgur.com/J6nnDm2
https://meinkonto.telekom-dienste.de...nt/index.xhtml
https://meinkonto.telekom-dienste.de...erstatus.xhtml
UserStatus.jpg : https://imgur.com/IqjhWop

New Email Address
New Email Address.jpg : https://imgur.com/zH2G73c

Register
Register.JPG : https://imgur.com/570UkbH
https://imgur.com/D6vRwex
You will probably be sent a number code via SMS to your Telephine number. , https://imgur.com/eBpabq5 ,

In support to answer of this Thread:
http://www.excelfox.com/forum/showth...ll=1#post11557

_____ Workbook: VBA.xls ( Using Excel 2007 32 bit )

Row\Col	A
1	1234
2	5678
3	91011
4	12131415
5	1617181920

Worksheet: abc
'match column A of abc sheet with column A of def sheet
' if it matches then delete that data in column A of def
' "match column A of abc sheet with column A of def sheet if it matches then delete that data in column A of def"

_____ Workbook: VBA.xls ( Using Excel 2007 32 bit )

Row\Col	A	B	C
1	1234
2	15678
3	191011
4	112131415
5	16171811920		after the process completed delete all the data in this sheet

Worksheet: def
_____ Workbook: VBA Exampled.xls ( Using Excel 2007 32 bit )

15678

191011

112131415

16171811920

Worksheet: def
_____ Workbook: VBA Exampled.xls ( Using Excel 2007 32 bit )



'and the data which are not matched compare that data ( here 'that data' means unmatched data in abc. Right? ) with Fake Data and
' if matched then delete and again if there will be unmatched data ( here also 'unmatched data' means unmatched data in abc. Right? ) then
_____ Workbook: VBA.xls ( Using Excel 2007 32 bit )

Row\Col	A
1	115678
2	191011
3	1112131415
4	1.16172E+11

Worksheet: Fake Data
_____ Workbook: VBA Exampled.xls ( Using Excel 2007 32 bit )

15678

112131415

16171811920

Worksheet: def

115678

1112131415

1.16172E+11

Worksheet: Fake Data



'................................................. ...................if there will be unmatched data then
' compare that data with complete data
_____ Workbook: VBA.xls ( Using Excel 2007 32 bit )

Row\Col	A	B
1	115678
2

Worksheet: Completed
' if found then delete and again if there will be unmatched data

1112131415

1.16172E+11

Worksheet: Fake Data
then
' copy that data and paste it to missing data sheet in column A ( and finally delete all the data in def : after the process completed delete all the data in this sheet )

Quote:

---

Originally Posted by fixer

the final result is in missing data sheet plz see
missing data sheet already has data and we have pasted the result below that data(the data starts with A2 is the result)
A1 in missing data sheet already has data so we putted the result below that plz see sir
....in simple words with def sheet the data which are present in column A doesnt match with any sheet column A data then put that data in missing data sheet sir (sheet can be many)

---

_____ Workbook: VBA.xls ( Using Excel 2007 32 bit )

Row\Col	A	B
1	11111158
2	1112131415
3	1.16172E+11
4

Worksheet: Missing data
_____ Workbook: VBA Exampled.xls ( Using Excel 2007 32 bit )

11111158

1112131415

1.16172E+11

Worksheet: Missing data

follow on from last post:

Before

Quote:

---

Originally Posted by fixer

the final result is in missing data sheet plz see
missing data sheet already has data and we have pasted the result below that data(the data starts with A2 is the result)
A1 in missing data sheet already has data so we putted the result below that plz see sir

---

_____ Workbook: VBA Before.xls ( Using Excel 2007 32 bit )

Row\Col	A	B
1	11111158
2
3
4

Worksheet: Missing data
_____ Workbook: VBA Before.xls ( Using Excel 2007 32 bit )

Row\Col	A	B
1	1234
2	5678
3	91011
4	12131415
5	1617181920
6

Worksheet: abc
_____ Workbook: VBA Before.xls ( Using Excel 2007 32 bit )

Row\Col	A	B	C
1	1234
2	15678
3	191011
4	112131415
5	16171811920		after the process completed delete all the data in this sheet

Worksheet: def
_____ Workbook: VBA Before.xls ( Using Excel 2007 32 bit )

Row\Col	A	B
1	115678
2	191011
3	1112131415
4	1.16172E+11
5

Worksheet: Fake Data
_____ Workbook: VBA Before.xls ( Using Excel 2007 32 bit )

Row\Col	A	B
1	115678
2

Worksheet: Completed
_____ Workbook: VBA Before.xls ( Using Excel 2007 32 bit )

Row\Col	A	B
1	11111158
2
3
4

Worksheet: Missing data

Follow on from last 2 posts





Explanation attempt
Column A of worksheet abc is compared with column A of worksheet def, looking for matches in data. If data in Column A of worksheet def is also found in column A of worksheet abc, then that matched data in column A of worksheet def is deleted
_____ Workbook: VBA worked excample.xls ( Using Excel 2007 32 bit )

Row\Col	A	B
1	1234
2	5678
3	91011
4	12131415
5	1617181920
6

Worksheet: abc
_____ Workbook: VBA worked excample.xls ( Using Excel 2007 32 bit )

Row\Col	A
1	1234
2	15678
3	191011
4	112131415
5	16171811920

Worksheet: def
Column A of worksheet abc is compared with column A of worksheet def, looking for matches in data. If data in Column A of worksheet def is also found in column A of worksheet abc, then that matched data in column A of worksheet def is deleted
_____ Workbook: VBA worked excample.xls ( Using Excel 2007 32 bit )

1234

15678

191011

112131415

16171811920

Worksheet: def (modified)


The remain data in worksheet def is now compared with column A of worksheet Fake Data.
_____ Workbook: VBA worked excample.xls ( Using Excel 2007 32 bit )

Row\Col	A	B
1	115678
2	191011
3	1112131415
4	1.16172E+11
5

Worksheet: Fake Data
If data in Column A of worksheet Fake Data is also found in column A of the modified worksheet def, then that matched data in column A of worksheet Fake Data is deleted
_____ Workbook: VBA worked excample.xls ( Using Excel 2007 32 bit )

115678

191011

1112131415

1.16172E+11

Worksheet: Fake Data (modified)

The remaining data in column A of modified worksheet Fake Data is now compared with column A of worksheet Completed
_____ Workbook: VBA worked excample.xls ( Using Excel 2007 32 bit )

Row\Col	A	B
1	115678
2

Worksheet: Completed
If there is a match in data in columns A of worksheet Completed, and column A of worksheet Fake Data, then delete that matched data from worksheet Fake Data
_____ Workbook: VBA worked excample.xls ( Using Excel 2007 32 bit )

115678

191011

1112131415

1.16172E+11

Worksheet: Fake Data (modified)

If there is now any remaining data in column A of modified Fake Data, then that data is added to column A of missing data , ( in the given example, VBA Before.xls , A1 in missing data sheet already had data
_____ Workbook: VBA worked excample.xls ( Using Excel 2007 32 bit )

Row\Col	A
1	11111158
2

Worksheet: Missing data
so we put the result below that:
_____ Workbook: VBA worked excample.xls ( Using Excel 2007 32 bit )

Row\Col	A	B
1	11111158
2	1112131415
3	1.16172E+11
4

Worksheet: Missing data (final)

Coding for this Thread
http://www.excelfox.com/forum/showth...ll=1#post11794

Code:

---

Sub MakeFormulas3() '  http://www.excelfox.com/forum/showthread.php/2390-Apply-Vlookup-formula-in-all-the-available-sheets-in-a-workbook?p=11794&viewfull=1#post11794
Rem 1 '  Workbooks info
' 1a This months book, this workbook. It is the outout book for the current month
Dim ThisMonthsLatestBook As Workbook, LisWbName As String
 Set ThisMonthsLatestBook = ThisWorkbook ' ActiveWorkbook
 Let LisWbName = ThisMonthsLatestBook.Name
    If InStr(7, LisWbName, Format(Now(), "MMM"), vbTextCompare) = 0 Then MsgBox Prompt:="This workbook is not for " & Format(Now(), "MMMM"): Exit Sub
Dim BookN As Long
 Let BookN = Mid(LisWbName, 5, InStr(5, LisWbName, "_", vbBinaryCompare) - 5)
' 1b Last months book
Dim sourceBookName As String
 Let sourceBookName = "Book" & BookN - 1 & "_" & Format(DateAdd("m", -1, Now()), "MMM YYYY") & ".xlsm"
Dim sourceBook As Workbook
 Set sourceBook = Workbooks.Open(ThisWorkbook.Path & "\" & sourceBookName)
Rem 2  Make records worksheet                                                                  Sub MakeWorkSheetIfNotThere()
'Dim Wb As Workbook '                                  ' ' Dim:  ' Preparing a "Pointer" to an Initial "Blue Print" in Memory of the Object ( Pigeon Hole with a bit of paper or code lines on that can be filled in to refer to a specific Objec of this type ) . This also us to get easily at the Methods and Properties throught the applying of a period ( .Dot) ( intellisense )                    '
' Set Wb = ActiveWorkbook '  '                            Set now (to Active Workbook - one being "looked at"), so that we carefull allways referrence this so as not to go astray through Excel Guessing inplicitly not the one we want...        Set: Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191                                '
    If Not Evaluate("=ISREF(" & "'" & "Records" & "'!Z78)") Then '  ( the '  are not important here, but iin general allow for a space in the worksheet name like  "My Records"
    ThisMonthsLatestBook.Worksheets.Add After:=ThisMonthsLatestBook.Worksheets.Item(Worksheets.Count) 'A sheeet is added and will be Active
    Dim wsRcds As Worksheet '
    Set wsRcds = ThisMonthsLatestBook.Worksheets.Item(ThisMonthsLatestBook.Worksheets.Count)        'Rather than rely on always going to the active sheet, we referr to it Explicitly so that we carefull allways referrence this so as not to go astray through Excel Guessing implicitly not the one we want...    Set: Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191            ' Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191
    wsRcds.Activate: wsRcds.Cells(1, 1).Activate ' ws.Activate and activating a cell sometimes seemed to overcome a strange error
    Let wsRcds.Name = "Records"
    Else ' The worksheet is already there , so I just need to set my variable to point to it
    Set wsRcds = ThisWorkbook.Worksheets("Records")
    End If
'                                                                                              End Sub
Rem 3 looping through worksheets
Dim C As Long, I As Long
'C = ActiveWorkbook.Worksheets.Count
 'Let C = ThisWorkbook.Worksheets.Count
 Let C = ThisMonthsLatestBook.Worksheets.Count - 1  '  -1 since last worksheet is records worksheet
    'For I = 1 To C
'Application.ScreenUpdating = True
    For I = 1 To C  '  Sheet1  , Sheet2  , Sheet3 .......
    'what are  our worksheets?                        I  =  1        ,      2 ,      3    ..........
    Dim sourceSheet As Worksheet
    Set sourceSheet = sourceBook.Worksheets.Item(I) '    ("Sheet1")  , Sheet2  , Sheet3 ........
    Dim outputSheet As Worksheet
    Set outputSheet = ThisWorkbook.Worksheets.Item(I) ' ("Sheet1")    , Sheet2  , Sheet3 ........
     
        'Determine last row of source
        With sourceSheet
        Dim SourceLastRow As Long
        SourceLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With
        With outputSheet
        'Determine last row in col P
        Dim OutputLastRow As Long
        OutputLastRow = .Cells(.Rows.Count, "P").End(xlUp).Row
        End With
        'Apply our formula in records worksheet
        With Worksheets("Records")
        Let .Cells.Item(1, I).Value = sourceSheet.Name  '  Header in column as worksheet name
        '.Range("Q2:Q" & OutputLastRow).Formula = "=VLOOKUP($A2,'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$P$" & SourceLastRow & ",3,0)"
        .Range("" & CL(I) & "2:" & CL(I) & "" & OutputLastRow).Value = "=VLOOKUP(" & outputSheet.Name & "!$A2,'" & sourceBook.Path & "\" & "[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$P$" & SourceLastRow & ",3,0)"
'        .Range("" & CL(I) & "2:" & CL(I) & "" & OutputLastRow).Value = .Range("" & CL(I) & "2:" & CL(I) & "" & OutputLastRow).Value
        End With
    'MsgBox ActiveWorkbook.Worksheets(I).Name
    MsgBox ActiveWorkbook.Worksheets.Item(I).Name
    Next I
'Next P
Rem 4
Dim cel As Range
    With Worksheets("Records").UsedRange
        For Each cel In .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
            If IsError(cel.Value) Then
            '
            Else
                If cel.Value < 3 Then
                cel.Font.Color = vbRed
                Else
                cel.Font.Color = vbGreen
                End If
            End If
        Next cel
    End With
   
'Close the source workbook, don't save any changes
 sourceBook.Close False
' Application.ScreenUpdating = True
End Sub
'  https://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980
Function CL(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
Dim rest As Long 'Variable for what is "left over" after subtracting as many full 26's as possible
    Do
    '    Let rest = ((lclm - 1) Mod 26) 'Gives 0 to 25 for Column Number "Left over" 1 to 26. Better than ( lclm Mod 26 ) which gives 1 to 25 for clm 1 to 25 then 0 for 26
    '    Let FukOutChrWithDoWhile = Chr(65 + rest) & FukOutChrWithDoWhile 'Convert rest to Chr Number, initially with full number so the "units" (0-25), then number of 26's left over (if the number was so big to give any amount of 26's in it, then number of 26's in the 26's left over (if the number was so big to give any amount of 26 x 26's in it, Enit ?
    '    'OR
    Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL
    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.
    'lclm = (lclm - (rest + 1)) \ 26 ' As the number is effectively truncated here, any number from 1 to (rest +1)  will do in the formula
    Loop While lclm > 0 'Only loop further if number was big enough to still have 0-25's in it
End Function

---

Notes in support of this Forum Question:
https://www.eileenslounge.com/viewto...p?f=18&t=33834

Trying to figure out how Excel Clipboard ( or maybe Office clipboard ) is interacting with the Windows clipboard when trying to paste into Excel a text string,….

I have a text string. I add to it, manipulate it a bit, then put it in "the clipboard", ( probably the windows clipboard ) , then do an Excel Worksheets Paste …

Simplified example…
I have this already in a string,
"A" & vbCr & vbLf & "C"
Seen in another way:
A_vbCr_vbLf_B
The first representation is in a typical code line convention, the second an attempt at a more "real" view
There are 4 characters there. The middle two are examples of types that are often referred to as "invisible" characters. (These two typically instruct systems to go to a new line)
Most software that visibly gives you some sort of text to see , would usually interpret that as two lines of text. For example, Excel would usually interpret that such as to display you something like this, if you somehow "put it in" the start ( top left ) of a spreadsheet:

Row\Col	A
1	A
2	C

I want to put an extra cell with split line text in it, simplified like this:

Row\Col	A
1	A
2	X Y
3	C

Sometime or other I have learnt that Excel recognises a single vbLf to split up lines of text within a cell. But it turns out to be bit more complicated than that if you want the text string in the Windows Clipboard to come out as you want it in Excel.

The second part of this macro seems to usually achieve the second screenshot above

Code:

---

Sub TestvbLf_1()
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Dim StringBack As String
' Fill two rows , in 1 column
 ActiveSheet.Cells.Clear ' This is important to remove any formatting that might distort results
 objDataObject.SetText "A" & vbCr & vbLf & "C": objDataObject.PutInClipboard
 ActiveSheet.Paste Destination:=ActiveSheet.Range("A1")
 objDataObject.GetFromClipboard: Let StringBack = objDataObject.GetText()
 Call WtchaGot(StringBack) '        "A" & vbCr & vbLf & "C"
' Put an extra cell with split line text in it
 ActiveSheet.Cells.Clear '
 objDataObject.SetText "A" & vbCr & vbLf & """" & "X" & vbLf & "Y" & """" & vbCr & vbLf & "C": objDataObject.PutInClipboard
 ActiveSheet.Paste Destination:=ActiveSheet.Range("A1")
 objDataObject.GetFromClipboard: Let StringBack = objDataObject.GetText()
 Call WtchaGot(StringBack) '          "A" & vbCr & vbLf & """" & "X" & vbLf & "Y" & """" & vbCr & vbLf & "C"
 
End Sub

---

( The function, WtchaGot( ) can be found here: http://www.excelfox.com/forum/showth...ll=1#post10946 )

---

Here are some further sample code snippets and discussions

This code snippet suggest to me that the Windows clipboard is being used, as .Clear does not empty "the clipboard" , as one more typically annoyingly experiences in Excel work when copying things manually or with VBA in Excel

Code:

---

Sub TestvbLf_2()
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Dim StringBack As String

' Put an extra cell with split line text in it
 ActiveSheet.Cells.Clear '
 objDataObject.SetText "A" & vbCr & vbLf & """" & "X" & vbLf & "Y" & """" & vbCr & vbLf & "C": objDataObject.PutInClipboard
 ActiveSheet.Paste Destination:=ActiveSheet.Range("A1")
 objDataObject.GetFromClipboard: Let StringBack = objDataObject.GetText()
 Call WtchaGot(StringBack) '  ---    "A" & vbCr & vbLf & """" & "X" & vbLf & "Y" & """" & vbCr & vbLf & "C"
 
 ActiveSheet.Cells.Clear ' This does not clear the clipboard, so next line gives the same results, which...
 ActiveSheet.Paste Destination:=ActiveSheet.Range("A1") '  suggests that the Windows  clipboard is being used
 Call WtchaGot(StringBack) '  ---    "A" & vbCr & vbLf & """" & "X" & vbLf & "Y" & """" & vbCr & vbLf & "C"
'
End Sub

---

Finally we see this, the orange of the clipboard icon indicating something is in "the clipboard", presumably the windows clipboard, since , as said, .Clear does not clear that icon, and also we see that the office clipboard is empty…
TestvbLf_2.JPG : https://imgur.com/dEbsaPE
Attachment 2565

( Using Excel 2007 32 bit )

A	19 Dez 2019 Lenf is 11	A "X Y" C
X Y	1 A	65
C	2	13
	3	10
	4 "	34
	5 X	88
	6	10
	7 Y	89
	8 "	34
	9	13
	10	10
	11 C	67

Worksheet: WotchaGotInString
The second two columns are produced by function WtchaGot( ) , and give a breakdown of the 11 characters in the string:
"A" & vbCr & vbLf & """" & "X" & vbLf & "Y" & """" & vbCr & vbLf & "C"
A vbCr vbLf " X vbLf Y " vbCr vbLf C

Further investigation in next post

In support of these posts

https://stackoverflow.com/questions/...60767#54960767
https://www.eileenslounge.com/viewto...p?f=18&t=33834



Thoughts on adding split lines in Excel cells via the ( probably windows ) Clipboard

The following code snippet is typical of those which got me to the solution of how to manipulate a text string so that it pastes into Excel a cell with multiple lines.
The first section shows me what the text in "the clipboard" looks like after using Excel ways to copy my final desired test form , after using Excel ways to produce it. It gives this sort of output
"A" & vbCr & vbLf & """" & "X" & vbLf & "Y" & """" & vbCr & vbLf & "C" & vbCr & vbLf
A vbCr vbLf " X vbLf Y " vbCr vbLf C vbCr vbLf
TestvbLf_3.jpg : https://imgur.com/oPXJIkG
Attachment 2566

Either code sections 2 and 3 would error, presumably because the windows clipboard has been emptied. That is not totally understandable. We know that we had something in the windows clipboard. Doing things that empty "clipboards" , possibly other than the window clipboard, seem also somehow to remove things from the windows clipboard.
Possibly we could explain this by saying that as Excel filled the windows clipboard as a sort of extra thing to do after primarily filling its clipboard, then some linking wiring in place to do that also resulted into it clearing the windows clipboard when it cleared its clipboard
Code section 4 erroring is less understandable, as we did not use normal Excel ways to fill the window clipboard, but never the less .Clear seems to empty it.
Code section 5 erroring is similarly less understandable, since it is generally considered that Application.CutCopyMode = False clears the Excel clipboard

Before going on to sections 7 and 8, copy something to the "clipboard" from anywhere.
We find that section 7 and 8 would still error. This once again seems to be caused by either .Clear or .CutCopyMode = False. It suggests that there is some link to the windows clipboard that causes it to be cleared. It suggests perhaps that something has been set to link things in the windows clipboard from Excel or office, possibly to get some formatting parameters. If you put anything into the windows clipboard, it will still be cleared when doing .Clear or .CutCopyMode = False , by virtue of this linking "wiring"

Section 9 probably removes this linking wiring.
When a manual copy is then made in the following sections , possibly a new wiring is set up which has a different sort of dependency.

Before going on to section 10 and then again before going on to section 11, copy something to the "clipboard" from anywhere.
The code lines of .Clear or .CutCopyMode = False at the start of these sections do not remove the orange from the icon top left, and code sections 10 and 11 do not error. This supports the idea that a link was made to the windows clipboard that works slightly differently.

Code:

---

Sub TestvbLf_3()
ActiveSheet.Cells.Clear


Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Dim StringBack As String
' Section 1
 ActiveSheet.Range("A1").Value = "A"
 ActiveSheet.Range("A2").Value = "X" & vbLf & "Y"
 ActiveSheet.Range("A3").Value = "C"
 ActiveSheet.Range("A1:A3").Copy
 objDataObject.GetFromClipboard: Let StringBack = objDataObject.GetText()
 Call WtchaGot(StringBack)
 'ActiveSheet.Cells.Clear ' --- This clears "the clipboard",
 ActiveSheet.Paste Destination:=ActiveSheet.Range("D1")
 
' Section 2
' ActiveSheet.Cells.Clear ' --- This clears "the clipboard"
' objDataObject.GetFromClipboard: Let StringBack = objDataObject.GetText() ' This errors
' Call WtchaGot(StringBack)

' Section 3
' Application.CutCopyMode = False
' objDataObject.GetFromClipboard: Let StringBack = objDataObject.GetText() ' This errors
' Call WtchaGot(StringBack)

' Section 4
' objDataObject.SetText "A" & vbCr & vbLf & """" & "X" & vbLf & "Y" & """" & vbCr & vbLf & "C": objDataObject.PutInClipboard
' ActiveSheet.Cells.Clear
' objDataObject.GetFromClipboard: Let StringBack = objDataObject.GetText() ' This errors
' Call WtchaGot(StringBack)

' Section 5
' objDataObject.SetText "A" & vbCr & vbLf & """" & "X" & vbLf & "Y" & """" & vbCr & vbLf & "C": objDataObject.PutInClipboard
' Application.CutCopyMode = False
' objDataObject.GetFromClipboard: Let StringBack = objDataObject.GetText()
' Call WtchaGot(StringBack)
 
Stop  ' BEFORE DOING THE NEXT CODE SECTIONs, copy something manually via Ctrl+c ...
' Section 7
' ActiveSheet.Cells.Clear
' objDataObject.GetFromClipboard: Let StringBack = objDataObject.GetText() ' This errors
' Call WtchaGot(StringBack)
'
'' Section 8
' Application.CutCopyMode = False
' objDataObject.GetFromClipboard: Let StringBack = objDataObject.GetText() ' This errors
' Call WtchaGot(StringBack)

' Section 9
 ActiveSheet.Cells.Clear  ' This I think breaks the link from other clipboards to the windows clipboard.
' Application.CutCopyMode = False ' this line as alternative to the last has the same effect

Stop  ' BEFORE DOING THE NEXT CODE SECTIONs, copy something manually via Ctrl+c ...

' Section 10
 ActiveSheet.Cells.Clear
 objDataObject.GetFromClipboard: Let StringBack = objDataObject.GetText()
 Call WtchaGot(StringBack)
 ActiveSheet.Paste Destination:=ActiveSheet.Range("E1")

Stop  ' BEFORE DOING THE NEXT CODE SECTIONs, copy something manually via Ctrl+c ...

' Section 11
 Application.CutCopyMode = False
 objDataObject.GetFromClipboard: Let StringBack = objDataObject.GetText()
 Call WtchaGot(StringBack)
 ActiveSheet.Paste Destination:=ActiveSheet.Range("H1")

End  Sub

---

Some notes in support of these Threads
http://www.eileenslounge.com/viewtopic.php?f=18&t=33775
http://www.eileenslounge.com/viewtop...d7141c#p262009
http://www.excelfox.com/forum/showth...ll=1#post11570
http://www.excelfox.com/forum/showth...ll=1#post11608



VPN and IP Addresses
Some of the initial investigations into testing VPN and in looking at problems showed that it was useful to be able to monitor various IP addresses.
The main (Public) address, as already discussed, ( http://www.excelfox.com/forum/showth...ll=1#post11597 ) , is of course important to know . There is also a "local host", which more typically is set to the same number for everyone, (127.0.0.1 ). This is a number which conventionally is used to allow direct access to network aspects of your computer which might otherwise be accessed externally in some way or another. A characteristic of VPN software is that it manipulate your computer in a way such that, amongst other things , this number will change to the internal address used at your VPN provider to identify you within their system. It is part of the trickery in the Client software, that you "looking at yourself" gets manipulated into looking somewhere else. The provider in some ways is then in control of your computer allowing them to give the impression that your computer is physically somewhere else: Part of your computer "Soul" is with them.

Public address
Manually this is achieved typically by visiting various sites that provide you with this information. The automated way still needs to use such sites. The reason for this is that you need to be able to get the information by accessing yourself in the way that another computer connected to the internet "gets at you". Part of this process involves obtaining your public address as you communicate initially with them. We could scrap any site offering the service and pick out the IP address information.
We can simplify the coding to do this by accessing a site available which only gives the IP information, and which shows as the website that you "see" just that IP address number.
So for example if you type in your browser URL bar, http://myip.dnsomatic.com/ , then all you will see is the IP address. You will even see only that if you are in Google Chrome Browser and right click and view the Page Source
Page Source myip dnsomatic .JPG : https://imgur.com/uceUKE4

This information will be the entire .responseText received back. In normal scrapping coding you might feed this supplied text string into an object model software which allows you to then pick out using OOP type techniques what you want. If we use the site http://myip.dnsomatic.com/ , we don't need to take that extra step, and can simply view the entire .responseText , as this is the exact info we want.

( I found that sometimes the first one or few attemps did not work in the next coding, but almost always after a few attemopts it worked. So the recursion technique is used to call the Function a few times , if necerssary )

Code:

---

Option Explicit
Sub TestPubicIP()
Dim strIP As String
 Call PubicIP(strIP)
 MsgBox prompt:=strIP
 'Call WtchaGot(strIP)
End Sub
' Because we have ByRef PublicIP  , the is effectively taking the variable  strIP  into the function, and similarly in the  recursion Call line  that variable is taken.  Hopefull in one of the 5 attepts at running the Function  it will be filled.. We don't actually fill the pseudo variable  PubicIP  so no value is returned directly by the Function. (So we could have used a Sub()routine instead)  To get a returned value we look at the value in  strIP  after runing the routine , because , as said, hopefully that particular variable will have been added to
Function PubicIP(ByRef PublicIP As String, Optional ByVal Tries As Long) As String
    If Tries = 5 Then Exit Function
 On Error GoTo Bed
    With CreateObject("msxml2.xmlhttp")
    .Open "GET", "http://myip.dnsomatic.com", True ' 'just preparing the request type, how and what type... "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.
    'No extra info here for type GET
    '.setRequestHeader bstrheader:="Ploppy", bstrvalue:="Poo"
    .setRequestHeader bstrheader:="If-Modified-Since", bstrvalue:="Sat, 1 Jan 2000 00:00:00 GMT" '  https://www.autohotkey.com/boards/viewtopic.php?t=9554  ---  It will caching the contents of the URL page. Which means if you request the same URL more than once, you always get the same responseText even the website changes text every time. This line is a workaround : Set cache related headers.
    .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
 Let PublicIP = PageSrc: ' Debug.Print PubicIP
 'Call WtchaGot(PubicIP)
    If PublicIP = "" Then Call PubicIP(PublicIP, Tries + 1) ' Recursion Call line. I do this because sometines it seems to need more than one try before it works
Exit Function
Bed:
 Let PubicIP = Err.Number & ":  " & Err.Description: Debug.Print PubicIP
End Function

---

As an alternative , I have below a similar coding. It gets the page source from another site which shows your IP address. I found when looking at the page source in Google Chrome, that I could see the IP address conveniently showing between two simple text lines :
Page Source whatismyipaddress_com .JPG : https://imgur.com/LSvORAe
Attachment 2567

To VBA ( or most computer things), that text looks like a long string, and at that point we can imagine that it looks to the computer like any one of these 3 representations
……. ipt -->" & vbLf & "87" & "." & "101" & "." & "95" & "." & "204" & vbLf & "<!—do not scr……..
…….ipt --> vbLf 87.101.95.204 vbLf <!—do not scr ………….

…….ipt --> vbLf
87.101.95.204 vbLf
<!—do not scr ………….

We apply some simple VBA strings manipulation techniques to extract just the IP address number

Code:

---

'
Sub TestPubicIPwhatismyipaddress_com()
Dim strIP As String
 Let strIP = PubicIPwhatismyipaddress_com
 MsgBox prompt:=strIP
End Sub
Function PubicIPwhatismyipaddress_com() As String
 On Error GoTo Bed
    With CreateObject("msxml2.xmlhttp")
    .Open "GET", "https://whatismyipaddress.com/de/meine-ip", False ' 'just preparing the request type, how and what type... "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.
    'No extra info here for type GET
    '.setRequestHeader bstrheader:="Ploppy", bstrvalue:="Poo"
    .setRequestHeader bstrheader:="If-Modified-Since", bstrvalue:="Sat, 1 Jan 2000 00:00:00 GMT" '  https://www.autohotkey.com/boards/viewtopic.php?t=9554  ---  It will caching the contents of the URL page. Which means if you request the same URL more than once, you always get the same responseText even the website changes text every time. This line is a workaround : Set cache related headers.
    .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
 Let PubicIPwhatismyipaddress_com = PageSrc: ' Debug.Print PubicIPwhatismyipaddress_com
Dim IPadres As String, posIPadres1 As Long, posIPadres2 As Long
 Let posIPadres1 = InStr(1, PageSrc, "<!-- do not script -->", vbBinaryCompare)  '      Screenshot --->  Page Source whatismyipaddress_com .JPG : https://imgur.com/LSvORAe
 Let posIPadres2 = InStr(posIPadres1 + 1, PageSrc, "<!-- do not script -->", vbBinaryCompare)
 Let PubicIPwhatismyipaddress_com = Mid(PageSrc, posIPadres1 + 23, ((posIPadres2 - 1) - (posIPadres1 + 23)))
 Call WtchaGot(PubicIPwhatismyipaddress_com)
Exit Function
Bed:
 Let PubicIPwhatismyipaddress_com = Err.Number & ":  " & Err.Description: Debug.Print PubicIPwhatismyipaddress_com
End Function

---

---

Local Host address and computer name in the next post

Local Host address, Computer name
There are a couple of Win32 APIs which will get this information.
We just need to write a small amount of coding to get the function to do what we want and also a bit of manipulaation to give the information as we need it.
For the computer name this is simply a function to give us a string.

Code:

---

Option Explicit
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, ByRef nSize As Long) As Long
'  "GetComputerNameA" (ByVal lpBuffer As String, ByRef nSize As Long) As Long
Function ComputerName() As String                                                                                                                                                                        ' GHB and sex..
Dim NmeLen As Long, lngX As Long, strCompName As String
 Let NmeLen = 999: Let strCompName = "                                    "    ' variables must be initialised or API things often dont work                                                            ' String$(50, 0)
 Let lngX = GetComputerName(strCompName, NmeLen) '
    If lngX <> 0 Then ' returns 1 if it works
    Let ComputerName = strCompName '  Left$(strCompName, NmeLen)  ' The first argument variable gets like a LSet done on it
    Else
    Let ComputerName = "Couldn't get Computer name"
    End If
 Let ComputerName = Left$(ComputerName, NmeLen) ' We must do this as there is a  Chr(0)  after the name ....  Let ComputerName = Trim(ComputerName) ' this is no good, - it leaves Chr(0) on the end which means that ComputerName is the last thing that will get printed
 'Call WtchaGot(ComputerName)
End Function


---

The Win32 API for the local IP address is slightly more complicated. It will give us a table/ array of all the IP addresses held. The first is generally that we are interested in. it seems to be added when a VPN connection is made

Code:

---

Option Explicit
Private Declare Function GetIpAddrTable_API Lib "IpHlpApi" Alias "GetIpAddrTable" (ByRef pIPAddrTable As Any, ByRef pdwSize As Long, ByVal bOrder As Long) As Long    '  http://www.source-code.biz/snippets/vbasic/8.htm
'  "GetIpAddrTable" (ByRef pIPAddrTable As Any, ByRef pdwSize As Long, ByVal bOrder As Long) As Long
Public Function GetIpAddrTable() As String  '      Christian d'Heureuse, www.source-code.biz  http://www.source-code.biz/snippets/vbasic/8.htm
Rem 1 We give the API function some info , and that seems to make it fill up an array with table values
Dim Buf(0 To 1234) As Byte ' Buf(0 To 511) As Byte ' must be Byte or overflow at NrOfEntries
Dim BufSize As Long: Let BufSize = 12345
Dim rc As Long: Let rc = GetIpAddrTable_API(Buf(0), BufSize, 1)
  'If rc <> 0 Then Err.Raise vbObjectError, , "GetIpAddrTable failed with return value " & rc
Dim NrOfEntries As Integer: NrOfEntries = Buf(1) * 256 + Buf(0)
  'If NrOfEntries = 0 Then GetIpAddrTable = Array(): Exit Function

Dim i As Long
  For i = 0 To NrOfEntries - 1
    Dim j As Long, s As String
      For j = 0 To 3
      Dim Indcy As Long: Let Indcy = 4 + i * 24 + j
      s = s & IIf(j > 0, ".", "") & Buf(Indcy): Debug.Print Indcy & "  " & Buf(Indcy) ' This code line just builds the final string for each IP address, with a "." before all but the first of the 4 number parts  ---  for example like  192 . 168 . 2 . 110
      Next j
    Dim strIPs As String: Let strIPs = strIPs & "  " & s: Let s = ""
    Next
  GetIpAddrTable = strIPs: Debug.Print strIPs
End Function

'    4  127
'    5  0
'    6  0
'    7  1
'    28  192
'    29  168
'    30  2
'    31  110
'      127.0.0.1  192.168.2.110                                                                                          ' _

'    4  10
'    5  132
'    6  13
'    7  113
'    28  127
'    29  0
'    30  0
'    31  1
'    52  192
'    53  168
'    54  2
'    55  110
'      10.132.13.113  127.0.0.1  192.168.2.110
'    1  2  3    4  5  6  7      8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
'    25 26 27  28  29  30  31    32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
'    49 50 51  52  53  54  55
'              10  132  13  127
'              127  0  0  1
'              192 168  2  110

---

If we examine that coding above, and experiment with what it does, we see a couple of things:
Rem 1
_ It is doing a strange thing, as API's often do. That is to say the API works similarly to a normal VBA function, except the way each argument is a mystery.. following some set of rules/coding which probably the author wrote when he was drunk and no one can remember anymore.
You must make an array of Byte types. The array should be fairly big.
You must give the first array element and the size of the array to the API Function.
Then magically the array gets filled. Presumably some internally held table is put into the array
Rem 2
A bit of maths is done to pick out the elements we want from the returned filled array

The final analysis here of a typical output can be helpful to try and understand another way to get this information

Code:

---

'    1  2  3    4  5  6  7      8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
'    25 26 27  28  29  30  31    32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
'    49 50 51  52  53  54  55
'              10  132  13  127
'              127  0  0  1
'              192 168  2  110

---

Or maybe not. I am not sure. I doubt many people are…

Jaafar’s got a big one, but it doesn’t work for Excel 2016? Why?

This page 18 from post 171 / 18036 is for some notes to possibly help in getting this big macro to also work for Office 2016 and higher

This is post #172
https://www.excelfox.com/forum/showt...ge18#post18037
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page18#post18037
https://www.excelfox.com/forum/showt...ll=1#post18037
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=18037&viewfull=1#post18037

---

Some pics for these postings, amongst other things:
https://stackoverflow.com/questions/...37321#79137321
https://stackoverflow.com/questions/...37208#79137208
https://eileenslounge.com/viewtopic....cee8b7#p321817 https://eileenslounge.com/viewtopic....321817#p321817
https://eileenslounge.com/viewtopic....321822#p321822






Attachment 6095


https://postimg.cc/zHyFf6w2

https://i.postimg.cc/j2XgMrDT/Office...All-Button.jpg

https://i.postimg.cc/zHyFf6w2/Office...All-Button.jpg

https://i.postimg.cc/j2XgMrDT/Office...All-Button.jpg




See also https://www.excelfox.com/forum/showt...ll=1#post24324

This is post #173
https://www.excelfox.com/forum/showt...e18#post 18038
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page18#post 18038
https://www.excelfox.com/forum/showt...l=1#post 18038
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p= 18038&viewfull=1#post 18038

---

Some pics for these postings, amongst other things:
https://stackoverflow.com/questions/...37321#79137321
https://stackoverflow.com/questions/...37208#79137208
https://eileenslounge.com/viewtopic....cee8b7#p321817 https://eileenslounge.com/viewtopic....321817#p321817
https://eileenslounge.com/viewtopic....321822#p321822
http://www.eileenslounge.com/viewtopic.php?f=18&t=41566
https://www.excelfox.com/forum/showt...ll=1#post18039

Some pics of the Office’s Clipboard Viewer in different versions, (Seen in Excel)

https://i.postimg.cc/vmNJGfNg/Excel-...wer-XL2003.jpgAttachment 6090
https://i.postimg.cc/vmNJGfNg/Excel-...wer-XL2003.jpg



https://i.postimg.cc/T18BDGGT/Excel-...wer-XL2007.jpgAttachment 6091
https://i.postimg.cc/T18BDGGT/Excel-...wer-XL2007.jpg



https://i.postimg.cc/cHtVCCpD/Excel-...wer-XL2010.jpgAttachment 6092
https://i.postimg.cc/cHtVCCpD/Excel-...wer-XL2010.jpg


https://i.postimg.cc/Jh0wwPPC/Excel-...wer-XL2013.jpgAttachment 6094
https://i.postimg.cc/Jh0wwPPC/Excel-...wer-XL2013.jpg



https://i.postimg.cc/y8V4jVRd/Excel-...wer-XL2016.jpgAttachment 6093
https://i.postimg.cc/y8V4jVRd/Excel-...wer-XL2016.jpg

This is post #174
https://www.excelfox.com/forum/showt...e18#post 18039
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page18#post 18039
https://www.excelfox.com/forum/showt...l=1#post 18039
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p= 18039&viewfull=1#post 18039

---

Spy++
If you Google around for things like Microsoft Windows Spy++ and / or alternatives to that, then you will get some software offered that tells you some things about what is going on in windows. As part of trying to get clued up on things API and clipboard, I have looked at a small part of the explorer/tree like thing presented by such software around an Excel File, in particular to see if I can get any useful info about the Offices Clipboard Viewer, ( the thing pictured in the previous 2 posts above,
https://www.excelfox.com/forum/showt...ll=1#post18037
https://www.excelfox.com/forum/showt...ll=1#post18038 )


The following pics are in pairs for some different Office versions. The left is for before and the right for after, opening the OfficesClipboardViewer

Excel 2003

https://i.postimg.cc/SKGKFhkG/Excel-...ard-Viewer.jpg Attachment 6106
https://i.postimg.cc/SsskBYZy/XL-200...ard-Viewer.jpg -------------------- https://i.postimg.cc/YS8tDzzn/XL-200...ard-Viewer.jpg
https://i.postimg.cc/SKGKFhkG/Excel-...ard-Viewer.jpg

---

Excel 2007

https://i.postimg.cc/tgbgMTQT/Excel-...ard-Viewer.jpg Attachment 6107
https://i.postimg.cc/QCKstGGw/XL-200...ard-Viewer.jpg ----------------------- https://i.postimg.cc/zBc88DMT/XL-200...ard-Viewer.jpg
https://i.postimg.cc/tgbgMTQT/Excel-...ard-Viewer.jpg

---

Excel 2010

---

Excel 2013

https://i.postimg.cc/RCYZzG52/Excel-...ard-Viewer.jpg Attachment 6108
https://i.postimg.cc/c4841YdC/XL-201...ard-Viewer.jpg ------------------------------------- https://i.postimg.cc/4xk4Yd35/XL-201...ard-Viewer.jpg
https://i.postimg.cc/RCYZzG52/Excel-...ard-Viewer.jpg

---

Excel 2016

https://i.postimg.cc/sxMfhGSn/Excel-...ard-Viewer.jpg Attachment 6109
https://i.postimg.cc/W1GNgvFP/XL-201...ard-Viewer.jpg --------------------- https://i.postimg.cc/7LqxNW0J/XL-201...ard-Viewer.jpg
https://i.postimg.cc/sxMfhGSn/Excel-...ard-Viewer.jpg

related to the last few posts…

Some of the "Spy++" software allows you to drag a crosswire thingy into a window, and then you will likely get information about the window dragged into
( https://i.postimg.cc/ncBN23Rx/Drag-a...o-a-window.jpg
https://i.postimg.cc/XqPJHk4S/drag-i...wer-Window.jpg
https://i.postimg.cc/VsHhD1KM/XL-200...L9-Unicode.jpg )
If we do that for different version it may be telling us something about a change at Office 2016


Excel 2003
https://i.postimg.cc/vmLjzVKH/XL-200...L9-Unicode.jpg Attachment 6110
https://i.postimg.cc/VsHhD1KM/XL-200...L9-Unicode.jpg

---

Excel 2007
https://i.postimg.cc/WbQz0850/XL-200...L9-Unicode.jpg Attachment 6111
https://i.postimg.cc/WbQz0850/XL-200...L9-Unicode.jpg

---

Excel 2010

---

Excel 2013
https://i.postimg.cc/y8cdjRGt/XL-201...fuegen-2-0.jpg Attachment 6112
https://i.postimg.cc/y8cdjRGt/XL-201...fuegen-2-0.jpg

---

Excel 2016
https://i.postimg.cc/HsJjJR9p/XL-201...ND-Unicode.jpg Attachment 6113
https://i.postimg.cc/HsJjJR9p/XL-201...ND-Unicode.jpg

---

The last post inspired me a bit to take another look at this snippet.

Code:

---

Let hwndClip = FindWindowEx(Application.hWnd, 0, "EXCEL2", vbNullString)
Let hwndClip = FindWindowEx(hwndClip, 0, "MsoCommandBar", CommandBars(MyPain).NameLocal)
Let hwndClip = GetNextWindow(hwndClip, GW_CHILD)
Let hwndScrollBar = GetNextWindow(GetNextWindow(hwndClip, GW_CHILD), GW_CHILD)
   
    If hwndClip And hwndScrollBar Then
    GetWindowRect hwndClip, tRect1
    GetWindowRect hwndScrollBar, tRect2
    BringWindowToTop Application.hWnd
        For i = 0 To tRect1.Right - tRect1.Left Step 50
        tPt.x = tRect1.Left + i: tPt.Y = tRect1.Top - 10 + (tRect2.Top - tRect1.Top) / 2
            #If VBA7 And Win64 Then
            CopyMemory lngPtr, tPt, LenB(tPt)
            Let lResult = AccessibleObjectFromPoint(lngPtr, oIA, vKid)
            #Else
            Let lResult = AccessibleObjectFromPoint(tPt.x, tPt.Y, oIA, vKid)
            #End If '
            If InStr("Clear All Borrar todo Effacer tout Alle löschen La légende du bouton", oIA.accName(vKid)) Then
            Call oIA.accDoDefaultAction(vKid) ' This does the clearing,  and
                CommandBars(MyPain).Visible = Not bHidden '
                Let bHidden = False
                  Exit Sub
            End If
        DoEvents
        Next i
    End If

---

I did some modifications to help take a closer look
(The modifications are
_ 1) a small change to prevent the code erroring if finds a button or something without any caption
_2) some Debug.Print lines )

Here is the modified version

Code:

---

'                                1180958
Let hwndClip = FindWindowEx(Application.hwnd, 0, "EXCEL2", vbNullString):                Debug.Print "hwndClip      " & hwndClip
Let hwndClip = FindWindowEx(hwndClip, 0, "MsoCommandBar", CommandBars(MyPain).NameLocal): Debug.Print "hwndClip      " & hwndClip ' 591464
Let hwndClip = GetNextWindow(hwndClip, GW_CHILD):                                        Debug.Print "hwndClip      " & hwndClip '  721906
Let hwndScrollBar = GetNextWindow(GetNextWindow(hwndClip, GW_CHILD), GW_CHILD):          Debug.Print "hwndScrollBar " & hwndScrollBar  ' 787440
                                                                                          Debug.Print
    If hwndClip And hwndScrollBar Then
    GetWindowRect hwndClip, tRect1
    GetWindowRect hwndScrollBar, tRect2
    BringWindowToTop Application.hwnd
                                                                                          Debug.Print "  tRect1.Top  =  " & tRect1.Top & "  tRect2.Top  =  " & tRect2.Top
                                                                                          Debug.Print "( tRect1.Bottom = " & tRect1.Bottom & "  tRect2.Bottom = " & tRect2.Bottom & " )"
                                                                                          Debug.Print "Loop i from  0  To  (" & tRect1.Right & "-" & tRect1.Left & ")=" & tRect1.Right - tRect1.Left & "  Step 50"
        For i = 0 To tRect1.Right - tRect1.Left Step 50
        Let tPt.x = tRect1.Left + i
        Let tPt.Y = tRect1.Top - 10 + (tRect2.Top - tRect1.Top) / 2:                    Debug.Print "i=" & Format(i, "000") & "  tPt.x = " & tPt.x & "  tPt.Y = " & tPt.Y
            #If VBA7 And Win64 Then
            CopyMemory lngPtr, tPt, LenB(tPt)
            Let lResult = AccessibleObjectFromPoint(lngPtr, oIA, vKid)
            #Else
            Let lResult = AccessibleObjectFromPoint(tPt.x, tPt.Y, oIA, vKid)
            #End If '
                                                                                          Debug.Print "lResult " & lResult & "  vKid " & vKid & "  oIA.accName(vKid) """ & oIA.accName(vKid) & """"
            If oIA.accName(vKid) <> "" And InStr("Clear All Borrar todo Effacer tout Alle löschen La légende du bouton", oIA.accName(vKid)) > 0 Then
            Call oIA.accDoDefaultAction(vKid) ' This does the clearing,  and
                CommandBars(MyPain).Visible = Not bHidden '
                Let bHidden = False
                                                                        Debug.Print "Worked,  :-)"
                Stop: Exit Sub
            End If
        DoEvents
        Next i
    End If
Let CommandBars(MyPain).Visible = Not bHidden
 Debug.Print "Unable to clear the Office Clipboard, didn't work,  :-("
Stop
End Sub


---

Results in the next two posts
https://www.excelfox.com/forum/showt...ll=1#post18042
https://www.excelfox.com/forum/showt...ll=1#post18043

Here are the results for Office 2003 2007 2010 2013, they are similar, and note that for those office versions, 2003 2007 2010 2013, the big coding does what we want (** when run ) and all is well
( ** when stepped through in debug F8 mode from the VBEditor , some versions do not work )

---

2003
https://i.postimg.cc/8CgCckTn/XL-200...ons-on-Run.jpgAttachment 6114
https://i.postimg.cc/8CgCckTn/XL-200...ons-on-Run.jpg

Code:

---

' Excel 2003 Klaus Notebook
'  Results from Immediate window when Run the code, (from Excel or from the VBEditor)
'    hwndClip 25888836
'    hwndClip 29427046
'    hwndClip 460018
'    hwndScrollBar 656320
'
'      tRect1.Top  =  232  tRect2.Top  =  295
'    ( tRect1.Bottom = 436  tRect2.Bottom = 376 )
'    Loop i from  0  To  (853-653)=200  Step 50
'    i=000  tPt.x = 653  tPt.Y = 254
'    lResult 0  vKid 0  oIA.accName(vKid) "Zusammenstellen und Einfügen 2.0"
'    i=050  tPt.x = 703  tPt.Y = 254
'    lResult 0  vKid 1  oIA.accName(vKid) "Alle einfügen"
'    i=100  tPt.x = 753  tPt.Y = 254
'    lResult 0  vKid 0  oIA.accName(vKid) "Zusammenstellen und Einfügen 2.0"
'    i=150  tPt.x = 803  tPt.Y = 254
'    lResult 0  vKid 2  oIA.accName(vKid) "Alle löschen"
'    Worked,  :-)
'
'  Results from Immediate window when step debug mode from the VBEditor

'    hwndClip 25888836
'    hwndClip 29427046
'    hwndClip 460018
'    hwndScrollBar 656320
'
'      tRect1.Top  =  232  tRect2.Top  =  295
'    ( tRect1.Bottom = 436  tRect2.Bottom = 376 )
'    Loop i from  0  To  (853-653)=200  Step 50
'    i=000  tPt.x = 653  tPt.Y = 254
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    i=050  tPt.x = 703  tPt.Y = 254
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    i=100  tPt.x = 753  tPt.Y = 254
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    i=150  tPt.x = 803  tPt.Y = 254
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    i=200  tPt.x = 853  tPt.Y = 254
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    Unable to clear the Office Clipboard, didn't work,  :-(

' -------------------------------------------------------------------------------------------------------


'  Excel 2003  KB
'  Results from Immediate window when Run the code, (from Excel or from the VBEditor)

'    hwndClip      4785806
'    hwndClip 722274
'    hwndClip 2492028
'    hwndScrollBar 6096064
'
'      tRect1.Top  =  -782  tRect2.Top  =  -719
'    ( tRect1.Bottom = -73  tRect2.Bottom = -179 )
'    Loop i from  0  To  (1534-1334)=200  Step 50
'    i=000  tPt.x = 1334  tPt.Y = -760
'    lResult 0  vKid 0  oIA.accName(vKid) "Zusammenstellen und Einfügen 2.0"
'    i=050  tPt.x = 1384  tPt.Y = -760
'    lResult 0  vKid 1  oIA.accName(vKid) "Alle einfügen"
'    i=100  tPt.x = 1434  tPt.Y = -760
'    lResult 0  vKid 0  oIA.accName(vKid) "Zusammenstellen und Einfügen 2.0"
'    i=150  tPt.x = 1484  tPt.Y = -760
'    lResult 0  vKid 2  oIA.accName(vKid) "Alle löschen"
'    Worked,  :-)


'  Results from Immediate window when step debug mode from the VBEditor
'    hwndClip 4785806
'    hwndClip 722274
'    hwndClip 2492028
'    hwndScrollBar 6096064
'
'      tRect1.Top  =  -782  tRect2.Top  =  -719
'    ( tRect1.Bottom = -73  tRect2.Bottom = -179 )
'    Loop i from  0  To  (1534-1334)=200  Step 50
'    i=000  tPt.x = 1334  tPt.Y = -760
'    lResult 0  vKid 0  oIA.accName(vKid) "Direktbereich"
'    i=050  tPt.x = 1384  tPt.Y = -760
'    lResult 0  vKid 0  oIA.accName(vKid) "Direktbereich"
'    i=100  tPt.x = 1434  tPt.Y = -760
'    lResult 0  vKid 0  oIA.accName(vKid) "Direktbereich"
'    i=150  tPt.x = 1484  tPt.Y = -760
'    lResult 0  vKid 0  oIA.accName(vKid) "Direktbereich"
'    i=200  tPt.x = 1534  tPt.Y = -760
'    lResult 0  vKid 0  oIA.accName(vKid) "Direktbereich"
'    Unable to clear the Office Clipboard, didn't work,  :-(

'  Some stuff copied from the spy after dragging into OfficesViewerPane
'    Caption:    Zusammenstellen und Einfügen 2.0
'    Class:      bosa_sdm_XL9  (Unicode)
'    Rectangle:  (1334,-782) - (1534,-73)  -  200x709
'    Client Rect: (0,0) - (200,709)  -  200x709
'
'

---

---

2007

https://i.postimg.cc/XvKYCMJN/XL-200...ons-on-Run.jpg Attachment 6115
https://i.postimg.cc/XvKYCMJN/XL-200...ons-on-Run.jpg

Code:

---

' Excel 2007 Klaus Notebook
'  Results from Immediate window when Run the code, (from Excel or from the VBEditor)
'    hwndClip 20579580
'    hwndClip 29689006
'    hwndClip 460302
'    hwndScrollBar 722120
'
'      tRect1.Top  =  206  tRect2.Top  =  256
'    ( tRect1.Bottom = 579  tRect2.Bottom = 541 )
'    Loop i from  0  To  (231-37)=194  Step 50
'    i=000  tPt.x = 37  tPt.Y = 221
'    lResult 0  vKid 0  oIA.accName(vKid) "Collect and Paste 2.0"
'    i=050  tPt.x = 87  tPt.Y = 221
'    lResult 0  vKid 1  oIA.accName(vKid) "Paste All"
'    i=100  tPt.x = 137  tPt.Y = 221
'    lResult 0  vKid 2  oIA.accName(vKid) "Clear All"
'    Worked,  :-)
'
'  Results from Immediate window when step debug mode from the VBEditor
'    hwndClip 20579580
'    hwndClip 29689006
'    hwndClip 460302
'    hwndScrollBar 722120
'
'      tRect1.Top  =  206  tRect2.Top  =  256
'    ( tRect1.Bottom = 579  tRect2.Bottom = 541 )
'    Loop i from  0  To  (231-37)=194  Step 50
'    i=000  tPt.x = 37  tPt.Y = 221
'    lResult 0  vKid 0  oIA.accName(vKid) "Collect and Paste 2.0"
'    i=050  tPt.x = 87  tPt.Y = 221
'    lResult 0  vKid 1  oIA.accName(vKid) "Paste All"
'    i=100  tPt.x = 137  tPt.Y = 221
'    lResult 0  vKid 2  oIA.accName(vKid) "Clear All"
'    Worked,  :-)

'  Some stuff copied from the spy after dragging into OfficesViewerPane
'    Caption:    Zusammenstellen und Einfügen 2.0
'    Class:      bosa_sdm_XL9  (Unicode)
'    Rectangle:  (37,206) - (231,579)  -  194x373
'    Client Rect: (0,0) - (194,373)  -  194x373


' -------------------------------------------------------------------------------------------------------


'    '  Excel 2007 KB
'  Results from Immediate window when Run the code, (from Excel or from the VBEditor)
'      tRect1.Top  =  -711  tRect2.Top  =  -661
'    ( tRect1.Bottom = -193  tRect2.Bottom = -229 )
'    Loop i from  0  To  (1434-1207)=227  Step 50
'    i=000  tPt.x = 1207  tPt.Y = -696
'    lResult 0  vKid 0  oIA.accName(vKid) "Collect and Paste 2.0"
'    i=050  tPt.x = 1257  tPt.Y = -696
'    lResult 0  vKid 1  oIA.accName(vKid) "Paste All"
'    i=100  tPt.x = 1307  tPt.Y = -696
'    lResult 0  vKid 2  oIA.accName(vKid) "Clear All"
'    Worked,  :-)
 
'  Results from Immediate window when step debug mode from the VBEditor
'      tRect1.Top  =  -725  tRect2.Top  =  -675
'    ( tRect1.Bottom = -159  tRect2.Bottom = -195 )
'    Loop i from  0  To  (1019-792)=227  Step 50
'    i=000  tPt.x = 792  tPt.Y = -710
'    lResult 0  vKid 0  oIA.accName(vKid) "Collect and Paste 2.0"
'    i=050  tPt.x = 842  tPt.Y = -710
'    lResult 0  vKid 1  oIA.accName(vKid) "Paste All"
'    i=100  tPt.x = 892  tPt.Y = -710
'    lResult 0  vKid 2  oIA.accName(vKid) "Clear All"
 '    Worked,  :-)

 
'  Some stuff copied from the spy after dragging into OfficesViewerPane
'    Caption:    Collect and Paste 2.0
'    Class:      bosa_sdm_XL9  (Unicode)
'    Rectangle:  (1207,-711) - (1434,-193)  -  227x518
'    Client Rect: (0,0) - (227,518)  -  227x518

---

---

2010
https://i.postimg.cc/023jgdFv/XL-201...ons-on-Run.jpg Attachment 6116
https://i.postimg.cc/023jgdFv/XL-201...ons-on-Run.jpg

Code:

---

' Excel 2010 Klaus Notebook
'    hwndClip 329404
'    hwndClip 329350
'    hwndClip 394808
'    hwndScrollBar 329338
'
'      tRect1.Top  =  209  tRect2.Top  =  259
'    ( tRect1.Bottom = 569  tRect2.Bottom = 534 )
'    Loop i from  0  To  (773-479)=294  Step 50
'    i=000  tPt.x = 479  tPt.Y = 224
'    lResult 0  vKid 0  oIA.accName(vKid) "Zusammenstellen und Einfügen 2.0"
'    i=050  tPt.x = 529  tPt.Y = 224
'    lResult 0  vKid 1  oIA.accName(vKid) "Alle einfügen"
'    i=100  tPt.x = 579  tPt.Y = 224
'    lResult 0  vKid 0  oIA.accName(vKid) "Zusammenstellen und Einfügen 2.0"
'    i=150  tPt.x = 629  tPt.Y = 224
'    lResult 0  vKid 2  oIA.accName(vKid) "Alle löschen"
'    Worked,  :-)
'
'  Results from Immediate window when step debug mode from the VBEditor
'    hwndClip 329404
'    hwndClip 329350
'    hwndClip 394808
'    hwndScrollBar 329338
'
'      tRect1.Top  =  209  tRect2.Top  =  259
'    ( tRect1.Bottom = 569  tRect2.Bottom = 534 )
'    Loop i from  0  To  (773-479)=294  Step 50
'    i=000  tPt.x = 479  tPt.Y = 224
'    lResult 0  vKid 0  oIA.accName(vKid) "Projektfenster"
'    i=050  tPt.x = 529  tPt.Y = 224
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    i=100  tPt.x = 579  tPt.Y = 224
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    i=150  tPt.x = 629  tPt.Y = 224
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    i=200  tPt.x = 679  tPt.Y = 224
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    i=250  tPt.x = 729  tPt.Y = 224
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    Unable to clear the Office Clipboard, didn't work,  :-(


'  Some stuff copied from the spy after dragging into OfficesViewerPane
'    Caption:    Zusammenstellen und Einfügen 2.0
'    Class:      bosa_sdm_XL9  (Unicode)
'    Rectangle:  (479,209) - (773,569)  -  294x360
'    Client Rect: (0,0) - (294,360)  -  294x360

' -------------------------------------------------------------------------------------------------------


  '    '  Excel 2010 Elfy
'  Results from Immediate window when Run the code, (from Excel or from the VBEditor)
'    hwndClip 461200
'    hwndClip 264628
'    hwndClip 264678
'    hwndScrollBar 330140

'      tRect1.Top  =  224  tRect2.Top  =  274
'    ( tRect1.Bottom = 819  tRect2.Bottom = 778 )
'    Loop i from  0  To  (808-514)=294  Step 50
'    i=000  tPt.x = 514  tPt.Y = 239
'    lResult 0  vKid 0  oIA.accName(vKid) "Zusammenstellen und Einfügen 2.0"
'    i=050  tPt.x = 564  tPt.Y = 239
'    lResult 0  vKid 1  oIA.accName(vKid) "Alle einfügen"
'    i=100  tPt.x = 614  tPt.Y = 239
'    lResult 0  vKid 0  oIA.accName(vKid) "Zusammenstellen und Einfügen 2.0"
'    i=150  tPt.x = 664  tPt.Y = 239
'    lResult 0  vKid 2  oIA.accName(vKid) "Alle löschen"
'    Worked,  :-)




'  Results from Immediate window when step debug mode from the VBEditor
'    hwndClip 461200
'    hwndClip 264628
'    hwndClip 264678
'    hwndScrollBar 330140
'
'      tRect1.Top  =  224  tRect2.Top  =  274
'    ( tRect1.Bottom = 819  tRect2.Bottom = 778 )
'    Loop i from  0  To  (808-514)=294  Step 50
'    i=000  tPt.x = 514  tPt.Y = 239
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    i=050  tPt.x = 564  tPt.Y = 239
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    i=100  tPt.x = 614  tPt.Y = 239
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    i=150  tPt.x = 664  tPt.Y = 239
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    i=200  tPt.x = 714  tPt.Y = 239
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    i=250  tPt.x = 764  tPt.Y = 239
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    Unable to clear the Office Clipboard, didn't work,  :-(

'  Some stuff copied from the spy after dragging into OfficesViewerPane
'    Caption:    Zusammenstellen und Einfügen 2.0
'    Class:      bosa_sdm_XL9  (Unicode)
'    Rectangle:  (347,205) - (641,800)  -  294x595
'    Client Rect: (0,0) - (294,595)  -  294x595

---

---

2013
https://i.postimg.cc/0ywQ9K1w/XL-201...ons-on-Run.jpg Attachment 6117
https://i.postimg.cc/0ywQ9K1w/XL-201...ons-on-Run.jpg

Code:

---

Results from Immediate window

 '      tRect1.Top  =  -327  tRect2.Top  =  -239
'    ( tRect1.Bottom = 6  tRect2.Bottom = -29 )
'    Loop i from  0  To  (2174-1990)=184  Step 50
'    i=000  tPt.x = 1990  tPt.Y = -293
'    lResult 0  vKid 0  oIA.accName(vKid) "Zusammenstellen und Einfügen 2.0"
'    i=050  tPt.x = 2040  tPt.Y = -293
'    lResult 0  vKid 2  oIA.accName(vKid) "Alle löschen"
'    Worked,  :-)

Some stuff copied from the spy after dragging into OfficesViewerPane
'    Caption:    Zusammenstellen und Einfügen 2.0
'    Class:      bosa_sdm_XL9  (Unicode)
'    Rectangle:  (1990,-327) - (2174,136)  -  184x463
'    Client Rect: (0,0) - (184,463)  -  184x463

---

---

Compared to the results for Offices 2003 2007 2010 and 2013 in the previous post, the results here for Office 2016 look a bit screwy.


https://i.postimg.cc/Y2djRwxh/XL-201...ons-on-Run.jpg
https://i.postimg.cc/Y2djRwxh/XL-201...ons-on-Run.jpg


Results from Immediate window when Run the code, (from Excel or from the VBEditor)

Code:

---

'    Running the coding:-
'    hwndClip 939260
'    hwndClip 676872
'    hwndClip 1003964
'    hwndScrollBar 610674
'
'      tRect1.Top  =  489  tRect2.Top  =  489
'    ( tRect1.Bottom = 1064  tRect2.Bottom = 1064 )
'    Loop i from  0  To  (989-733)=256  Step 50
'    i=000  tPt.x = 733  tPt.Y = 479
'    lResult 0  vKid 0  oIA.accName(vKid) ""
'    i=050  tPt.x = 783  tPt.Y = 479
'    lResult 0  vKid 0  oIA.accName(vKid) ""
'    i=100  tPt.x = 833  tPt.Y = 479
'    lResult 0  vKid 0  oIA.accName(vKid) ""
'    i=150  tPt.x = 883  tPt.Y = 479
'    lResult 0  vKid 0  oIA.accName(vKid) ""
'    i=200  tPt.x = 933  tPt.Y = 479
'    lResult 0  vKid 0  oIA.accName(vKid) "Optionen für den Aufgabenbereich"
'    i=250  tPt.x = 983  tPt.Y = 479
'    lResult 0  vKid 0  oIA.accName(vKid) ""
'    Unable to clear the Office Clipboard, didn't work,  :-(

---

Results from Immediate window when step debug mode from the VBEditor

Code:

---

'  Doing the coding in step debug mode
'    hwndClip 939260
'    hwndClip 676872
'    hwndClip 1003964
'    hwndScrollBar 610674
'
'      tRect1.Top  =  489  tRect2.Top  =  489
'    ( tRect1.Bottom = 1064  tRect2.Bottom = 1064 )
'    Loop i from  0  To  (989-733)=256  Step 50
'    i=000  tPt.x = 733  tPt.Y = 479
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    i=050  tPt.x = 783  tPt.Y = 479
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    i=100  tPt.x = 833  tPt.Y = 479
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    i=150  tPt.x = 883  tPt.Y = 479
'    lResult 0  vKid 0  oIA.accName(vKid) "OfficesClipboardViewerTests (Code)"
'    i=200  tPt.x = 933  tPt.Y = 479
'    lResult 0  vKid 0  oIA.accName(vKid) "Direktbereich"
'    i=250  tPt.x = 983  tPt.Y = 479
'    lResult 0  vKid 0  oIA.accName(vKid) "Direktbereich"
'    Unable to clear the Office Clipboard, didn't work,  :-(
'
 

---

Some stuff copied from the spy after dragging into OfficesViewerPane

Code:

---

'    Caption:        NO Caption!!!
'    Class:      NetUIHWND  (Unicode)
'    Rectangle:  (740,361) - (996,936)  -  256x575
'                (733,489) - (989,1064)  -  256x575
'    Client Rect: (0,0) - (256,575)  -  256x575
'

---

Some tests on the small codings

Some simple test based on this modified coding:

Code:

---

Sub small_20202024_ClearOfficeClipBoard_Tests()  '  https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues-and-otes-on-API-stuff?p=18044&viewfull=1#post18044

Dim avAcc, bClipboard As Boolean, j As Long, x As Long
Dim MyPain As String
    If CLng(Val(Application.Version)) <= 11 Then  '                  Case 11: "Excel 2003" Windows    "Excel 2004" mac
    Let MyPain = "Task Pane"
    Else
    Let MyPain = "Office Clipboard"
    End If
Set avAcc = Application.CommandBars(MyPain)  '
Let bClipboard = avAcc.Visible      '  bClipboard will be false if the viewer pain is not open
    If Not bClipboard Then
    avAcc.Visible = True          '  This opens the Viewer pain. The coding won't work if it is not open
    DoEvents: DoEvents
    Else
    End If
'  coding change for Office versions at  --  Office 2016  ==
    If CLng(Val(Application.Version)) < 16 Then
' --For Office versions 2003 2007 2010 2013 ----------------------------------------
        For j = 1 To 4        '      J =    1  2  3  4
        AccessibleChildren avAcc, Choose(j, 0, 3, 0, 3), 1, avAcc, 1
        Debug.Print "j " & j & "    ";
        Debug.Print "0&" & " " & avAcc.accName(CLng(0));
        On Error Resume Next
        Debug.Print "  1&" & " " & avAcc.accName(CLng(1));
        Debug.Print "  2&" & " " & avAcc.accName(CLng(2));
        Debug.Print "  3&" & " " & avAcc.accName(CLng(3));
        Debug.Print "  4&" & " " & avAcc.accName(CLng(4));
        Debug.Print "  5&" & " " & avAcc.accName(CLng(5));
        Debug.Print "  6&" & " " & avAcc.accName(CLng(6));
        Debug.Print "  7&" & " " & avAcc.accName(CLng(7));
        Debug.Print "  8&" & " " & avAcc.accName(CLng(8));
        Debug.Print "  9&" & " " & avAcc.accName(CLng(9))
        On Error GoTo 0
        Debug.Print
        Next
    avAcc.accDoDefaultAction 2&  '          This seems to do the clearing  It will NOT error if viewer pain is already  Cleared                  1& for paste
' ----------------------------------------------------------------------------------
    Else
' ==For Office versions 2016 and higher ==============================================
        For j = 1 To 7      '          J =  1  2  3  4  5  6  7
        AccessibleChildren avAcc, Choose(j, 0, 3, 0, 3, 0, 3, 1), 1, avAcc, 1
        Debug.Print "j " & j & "    ";
        Debug.Print "0&" & " " & avAcc.accName(CLng(0));
        On Error Resume Next
        Debug.Print "  1&" & " " & avAcc.accName(CLng(1));
        Debug.Print "  2&" & " " & avAcc.accName(CLng(2));
        Debug.Print "  3&" & " " & avAcc.accName(CLng(3));
        Debug.Print "  4&" & " " & avAcc.accName(CLng(4));
        Debug.Print "  5&" & " " & avAcc.accName(CLng(5));
        Debug.Print "  6&" & " " & avAcc.accName(CLng(6));
        Debug.Print "  7&" & " " & avAcc.accName(CLng(7));
        Debug.Print "  8&" & " " & avAcc.accName(CLng(8));
        Debug.Print "  9&" & " " & avAcc.accName(CLng(9))
        On Error GoTo 0
        Debug.Print
        Next
    avAcc.accDoDefaultAction 0& '            This seems to do the clearing  It WILL error if viewer pain is already  Cleared
    End If ' =======================================================================
 Let Application.CommandBars(MyPain).Visible = bClipboard      '  Puts the viewer pain back as it was, open or closed
End Sub


---

The results for the small codings are more consistent, and there is no strange problem of different results when done in step debug mode
Here some results for Offices 2003 2007 2010 2013

Code:

---

'  excel 2003 KB
' Run
'    j 1    0& 1 von 24 - Zwischenablage
'    j 2    0& 1 von 24 - Zwischenablage
'    j 3    0& Zusammenstellen und Einfügen 2.0
'    j 4    0& Zusammenstellen und Einfügen 2.0  1& Alle einfügen  2& Alle löschen  3& Klicken Sie zum Einfügen auf ein Element:  4& Zwischenablage  5& Zwischenablage  6& Um diesen Aufgabenbereich später einzublenden, wählen Sie Office-Zwischenablage aus dem Menü Bearbeiten oder drücken Sie Strg+C zwei mal.  7& Optionen
'  debug step from VBEditor
'    j 1    0& Zwischenablage
'    j 2    0& Zwischenablage
'    j 3    0& Zusammenstellen und Einfügen 2.0
'    j 4    0& Zusammenstellen und Einfügen 2.0  1& Alle einfügen  2& Alle löschen  3& Klicken Sie zum Einfügen auf ein Element:  4& Zwischenablage  5& Zwischenablage  6& Um diesen Aufgabenbereich später einzublenden, wählen Sie Office-Zwischenablage aus dem Menü Bearbeiten oder drücken Sie Strg+C zwei mal.  7& Optionen



' =============================================================================================

'  Excel 2007 KB
'  Run
'    j 1    0& Clipboard
'    j 2    0& Clipboard
'    j 3    0& Collect and Paste 2.0
'    j 4    0& Collect and Paste 2.0  1& Paste All  2& Clear All  3& Click an item to paste:  4& Clipboard  5& Clipboard  6& Options
'
'  Debug step from VBEditor
'    j 1    0& Clipboard
'    j 2    0& Clipboard
'    j 3    0& Collect and Paste 2.0
'    j 4    0& Collect and Paste 2.0  1& Paste All  2& Clear All  3& Click an item to paste:  4& Clipboard  5& Clipboard  6& Options
    '




'  ======================================================================================================000

'  2010  Elfy
'  Run
'    j 1    0& 1 von 24 - Zwischenablage
'    j 2    0& 1 von 24 - Zwischenablage
'    j 3    0& Zusammenstellen und Einfügen 2.0
'    j 4    0& Zusammenstellen und Einfügen 2.0  1& Alle einfügen  2& Alle löschen  3& Klicken Sie zum Einfügen auf ein Element:  4& Zwischenablage  5& Zwischenablage  6& Optionen
'
'  step debug
'    j 1    0& Zwischenablage
'    j 2    0& Zwischenablage
'    j 3    0& Zusammenstellen und Einfügen 2.0
'    j 4    0& Zusammenstellen und Einfügen 2.0  1& Alle einfügen  2& Alle löschen  3& Klicken Sie zum Einfügen auf ein Element:  4& Zwischenablage  5& Zwischenablage  6& Optionen


'  ====================================================================================================

'  2013 SerSzuD2
'  Run
'    j 1    0& Zwischenablage
'    j 2    0& Zwischenablage
'    j 3    0& Zusammenstellen und Einfügen 2.0
'    j 4    0& Zusammenstellen und Einfügen 2.0  1& Alle einfügen  2& Alle löschen  3& Klicken Sie auf ein Element, um es einzufügen:  4& Zwischenablage  5& Zwischenablage  6& Optionen
'
'  step debug
'    j 1    0& Zwischenablage
'    j 2    0& Zwischenablage
'    j 3    0& Zusammenstellen und Einfügen 2.0
'    j 4    0& Zusammenstellen und Einfügen 2.0  1& Alle einfügen  2& Alle löschen  3& Klicken Sie auf ein Element, um es einzufügen:  4& Zwischenablage  5& Zwischenablage  6& Optionen

---

Here the corresponding result for a Office 2016

Code:

---

' Excel 2016 Torrox
'  Run
'    j 1    0& Zwischenablage
'    j 2    0& Zwischenablage
'    j 3    0&
'    j 4    0&
'    j 5    0& Zwischenablage
'    j 6    0& Zwischenablage
'    j 7    0& Alle löschen
'
'  Debug step
'    j 1    0& Zwischenablage
'    j 2    0& Zwischenablage
'    j 3    0&
'    j 4    0&
'    j 5    0& Zwischenablage
'    j 6    0& Zwischenablage
'    j 7    0& Alle löschen

---