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

Printable View

Show 40 post(s) from this thread on one page

10-10-2020, 02:18 PM
DocAElstein

Some notes in support of these Threads
https://excelfox.com/forum/showthrea...urning-Nothing
https://excelfox.com/forum/showthrea...sult-Using-VBA

Google Browser Page HTML Source
Typically,
_ the first main section in internet page manipulation codings which try to get things from internet sites, is a code section which gets you a single, very long, text string of something similar to what your browser actually uses to present all you see.
( Google Browser also allows you to see in the browser all that text if you right click and select something like Show Page Source ( or use short cut key combination of Strg+u )
ShowPageSource.JPG PageSource.JPG :
https://imgur.com/UnAs5Le , https://imgur.com/bubFTet
https://i.imgur.com/UnAs5Le.jpg , https://i.imgur.com/bubFTet.jpg )

I am not 100% familiar with all the syntaxes and workings of this first code section, but usually they are similar in such codings, and usually I can get that code section to get the HTML page Source text string, ( and we can add a few extra code lines if we want to put all that text string into a text file , so that we can look at it , and use the simple search facility within a text editor, such as Notepad , to find things in that very long text string )
This first code section will get me that text string for a Google Search of ExcelFox , and it will put it in a text file with the name
GoogleSrchExcelFox.txt

Code:

Sub GoogleSearchURL() ' https://excelfox.com/forum/showthread.php/2656-Automated-Search-Results-Returning-Nothing https://excelfox.com/forum/showthread.php/973-Lookup-First-URL-From-Google-Search-Result-Using-VBA On Error GoTo Bed '_1 First section get the long text string of the HTML coding of the internet Page '_1(i) get the long single text string With CreateObject("msxml2.xmlhttp") .Open "GET", "https://www.google.com/search?q=ExcelFox", 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 '_1(ii) Optional secion to put the text string into a text file , for ease of code developments Dim FileNum2 As Long: Let FileNum2 = FreeFile(0) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function Dim PathAndFileName2 As String Let PathAndFileName2 = ThisWorkbook.Path & "\" & "GoogleSrchExcelFox" & ".txt" ' CHANGE TO SUIT Open PathAndFileName2 For Output As #FileNum2 ' CHANGE TO SUIT ' Will be made if not there Print #FileNum2, PageSrc ' Close #FileNum2

_ The second part of such internet page manipulation coding involve often putting that text into an Object that allows a Object oriented programming type analysis of the web page. That is rather advanced and I personally am not too experienced with that.

What I am proposing is a much simplified approach I used myself successfully a few times. It is so simple, that I guess it may not be reliable permanently, for example, when a small change is made to the source page coding by Google. On the other hand , often major changes make the more advanced coding no longer work.
My solution is probably best only to use if you can understand enough to modify it yourself later when it no longer works. That is why I will explain it in detail here.

Examine the string to find the info you want
My solution does very simple basic string manipulation to pick out what I want.
As example, I do google search for ExcelFox manually and programmatically…_
_ Manually:
https://imgur.com/M16cko3 : https://i.imgur.com/M16cko3.jpg
_ Programmatically :
I run the macro snippet above, and look at the text file produced in a text editor. Then I use the search option to look for ExcelFox
NotepadSearch.JPG , Notepad Search.JPG
https://imgur.com/L9dcXBf , https://imgur.com/K4kl3qk
https://i.imgur.com/L9dcXBf.jpg , https://i.imgur.com/K4kl3qk.jpg
If I compare the results of manually and programmatically, then I can pick out a pattern. ( Note: you must look at all the occurrences of ExcelFox – Some will be as part of a text that you don’t want, but you will see a match between the things shown manually, and the text got programmatically.
Example
My manual search got me this: ExcelFoxManaulGooglesearch.JPG : https://imgur.com/M16cko3
https://i.imgur.com/M16cko3.jpg
Consider the first three main URLs given by the search :
http://www.excelfox.com/forum/forum.php
https://excelfox.com/forum/forumdisp...p/2-Excel-Help
http://www.hifi-forum.de/bild/excel-...0e_737672.html
If I search in the text file, I can pick out those inside a similar text section…

Code:

' q=ExcelFox&source=lnms&tbm=nws&sa=X&ved=0ahUKEwjO9PiFs6jsAhXJzoUKHUj-DwcQ_AUIBygD">NEWS</a></td></tr></tbody></table></div></div><div><div> <div> <div class="ezO2md"><div><div><a class="fuLhoc ZWRArf" href="/url?q=http://www.excelfox.com/forum/forum.php&sa=U&ved=2ahUKEwjO9PiFs6jsAhXJzoUKHUj-DwcQFjAAegQIBxAB&usg=AOvVaw3c8Z4i7W8Ooq7f9a8C3CKw"><span class="CVA68e qXLe6d">Excel, ' <span class="qXLe6d FrIlee"> <span class="fYyStc">Have a question in Excel, Access, Powerpoint, Word or Outlook? Ask http://www.?excelfox.com/forum/forum.php.</span> </span> </div> </div></td></tr></table></div></div></div> </div> </div><div> <div> <div class="ezO2md"><div><div><a class="fuLhoc ZWRArf" href="/url?q=https://excelfox.com/forum/forumdisplay.php/2-Excel-Help&sa=U&ved=2ahUKEwjO9PiFs6jsAhXJzoUKHUj- ' Weitere Ergebnisse von excelfox.com</a> </span> </div> </div></td></tr></table></div></div></div> </div> </div><div> <div> <div class="ezO2md"><div><div><a class="fuLhoc ZWRArf" href="/url?q=http://www.hifi-forum.de/bild/excel-fox-700e_737672.html&sa=U&ved=2ahUKEwjO9PiFs6jsAhXJzoUKHUj-DwcQFjACegQIABAB&usg=AOvVaw1WljIWpaSLwuTcgdbTcLeU"><span class="CV

I now repeat the above experiment for a Google search on Chandoo
Manual search results:
ChandooManaulGooglesearch.JPG : https://imgur.com/eQSDHsz
https://i.imgur.com/eQSDHsz.jpg
Considering again just the first 3 results , we have
https://chandoo.org/
https://www.youtube.com/channel/UC8u...MHeeRma49dtZKA
https://de.wikipedia.org/wiki/Chandu
Programmatic ( looking through the produced text file to find something similar to the first 3 URLs from the manual search)
( This would be the macro to get the text file from that search : https://excelfox.com/forum/showthrea...ll=1#post14992 )

Code:

' /table></div></div></div> </div> </div><div> <div> <div class="ezO2md"><div><div><a class="fuLhoc ZWRArf" href="/url?q=https://chandoo.org/&sa=U&ved=2ahUKEwiFs9-r4KrsAhWNC-wKHSLMBb0QFjACegQICBAB& ' <div class="ezO2md"><div><div><a class="fuLhoc ZWRArf" href="/url?q=https://www.youtube.com/channel/UC8uU_wruBMHeeRma49dtZKA&sa=U&ved=2ahUKEwiFs9-r4KrsA ' /td></tr></table></div></div></div> </div> </div><div> <div> <div class="ezO2md"><div><div><a class="fuLhoc ZWRArf" href="/url?q=https://de.wikipedia.org/wiki/Chandu&sa=U&ved=2ahUKEwiFs9-r4KrsAhWNC-wKHSLMBb0QFjAEegQIARAB&usg=AOvVaw323MmSfVaurlycQW8E02XJ"><span class="CVA68e qXLe6d">Chandu – Wikipedia</span> <span class="qXLe6d dX

Solution based on simple string analysis
It appears as if we can easily pick out our required URLs from the text if we look for some of the text appearing just before all the URLs.
We could try for example, class="fuLhoc ZWRArf" href="/url?q=
We know then that the text after is out wanted URL
We can also see that we have consistently the same string after URL, so we know we can look for that in order to know the end of the URL text
The implementation of this is fairly simple VBA string manipulation.
10-10-2020, 02:18 PM
DocAElstein

Macro to get the text file from Google search on Chandoo

Some notes in support of these Threads
https://excelfox.com/forum/showthrea...urning-Nothing
https://excelfox.com/forum/showthrea...sult-Using-VBA

Code:

Sub GoogleSearchURL() ' https://excelfox.com/forum/showthread.php/2656-Automated-Search-Results-Returning-Nothing https://excelfox.com/forum/showthread.php/973-Lookup-First-URL-From-Google-Search-Result-Using-VBA On Error GoTo Bed '_1 First section get the long text string of the HTML coding of the internet Page '_1(i) get the long single text string With CreateObject("msxml2.xmlhttp") .Open "GET", "https://www.google.com/search?q=Chandoo", 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 '_1(ii) Optional secion to put the text string into a text file , for ease of code developments Dim FileNum2 As Long: Let FileNum2 = FreeFile(0) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function Dim PathAndFileName2 As String Let PathAndFileName2 = ThisWorkbook.Path & "\" & "Chandoo" & ".txt" ' CHANGE TO SUIT Open PathAndFileName2 For Output As #FileNum2 ' CHANGE TO SUIT ' Will be made if not there Print #FileNum2, PageSrc ' Close #FileNum2 End Sub

In support of this Thread
https://excelfox.com/forum/showthrea...tiple-Criteria
and answer
https://excelfox.com/forum/showthrea...ll=1#post15046

This is what the transpose of SM_T_D1() looks like ( SM_T_D1() is actually pseudo horizontal rather than vertical , as it is a 1D array )
_____ Workbook: AllFormulasAndVBAMultipleCriteria.xlsm ( Using Excel 2007 32 bit )

Sales Man Territory Dimension

John New York Tissue

Alfred Washington Soda

John New York Soda

Alfred New York Tissue

Leo Washington Soda

Leo New York Tissue

Maxwell Washington Towel

Here is the equivalent transpose of array, SM_T_D2()
_____ Workbook: AllFormulasAndVBAMultipleCriteria.xlsm ( Using Excel 2007 32 bit )

Sales Man Territory Dimension

John New York Tissue

John New York Soda

John New York Paper

John New York Towel

John Washington Tissue

John Washington Soda

John Washington Paper

John Washington Towel

Alfred New York Tissue

Alfred New York Soda

Alfred New York Paper

Alfred New York Towel

Alfred Washington Tissue

Alfred Washington Soda

Alfred Washington Paper

Alfred Washington Towel

Leo New York Tissue

Leo New York Soda

Leo New York Paper

Leo New York Towel

Leo Washington Tissue

Leo Washington Soda

Leo Washington Paper

Leo Washington Towel

Maxwell New York Tissue

Maxwell New York Soda

Maxwell New York Paper

Maxwell New York Towel

Maxwell Washington Tissue

Maxwell Washington Soda

Maxwell Washington Paper

Maxwell Washington Towel

In support of this answer
https://excelfox.com/forum/showthrea...ll=1#post15046

Before:
___ Workbook: AllFormulasAndVBAMultipleCriteria.xlsm ( Using Excel 2007 32 bit )

_Row\^Col A B C D E

1 Sales Man Territory Dimension Sales Amt Cost

2 John New York Tissue
1,000.00

200.00

3 Alfred Washington Soda
2,100.00

700.00

4 John New York Soda
2,050.00

1,500.00

5 Alfred New York Tissue
2,000.00

500.00

6 Leo Washington Soda
200.00

100.00

7 Leo New York Tissue
3,500.00

1,500.00

8 Maxwell Washington Towel
1,000.00

800.00

Worksheet: Export1

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

_Row\^Col A B C D E

1 Sales Man Territory Dimension Sales Amt Cost

2 John New York Tissue

3 John New York Soda

4 John New York Paper

5 John New York Towel

6 John Washington Tissue

7 John Washington Soda

8 John Washington Paper

9 John Washington Towel

10 Alfred New York Tissue

11 Alfred New York Soda

12 Alfred New York Paper

13 Alfred New York Towel

14 Alfred Washington Tissue

15 Alfred Washington Soda

16 Alfred Washington Paper

17 Alfred Washington Towel

18 Leo New York Tissue

19 Leo New York Soda

20 Leo New York Paper

21 Leo New York Towel

22 Leo Washington Tissue

23 Leo Washington Soda

24 Leo Washington Paper

25 Leo Washington Towel

26 Maxwell New York Tissue

27 Maxwell New York Soda

28 Maxwell New York Paper

29 Maxwell New York Towel

30 Maxwell Washington Tissue

31 Maxwell Washington Soda

32 Maxwell Washington Paper

33 Maxwell Washington Towel

Worksheet: ResultVBA

_Row\^Col	A	B	C	D	E
1	Sales Man	Territory	Dimension	Sales Amt	Cost
2	John	New York	Tissue	1,000.00	200.00
3	Alfred	Washington	Soda	2,100.00	700.00
4	John	New York	Soda	2,050.00	1,500.00
5	Alfred	New York	Tissue	2,000.00	500.00
6	Leo	Washington	Soda	200.00	100.00
7	Leo	New York	Tissue	3,500.00	1,500.00
8	Maxwell	Washington	Towel	1,000.00	800.00

_Row\^Col	A	B	C	D	E
1	Sales Man	Territory	Dimension	Sales Amt	Cost
2	John	New York	Tissue
3	John	New York	Soda
4	John	New York	Paper
5	John	New York	Towel
6	John	Washington	Tissue
7	John	Washington	Soda
8	John	Washington	Paper
9	John	Washington	Towel
10	Alfred	New York	Tissue
11	Alfred	New York	Soda
12	Alfred	New York	Paper
13	Alfred	New York	Towel
14	Alfred	Washington	Tissue
15	Alfred	Washington	Soda
16	Alfred	Washington	Paper
17	Alfred	Washington	Towel
18	Leo	New York	Tissue
19	Leo	New York	Soda
20	Leo	New York	Paper
21	Leo	New York	Towel
22	Leo	Washington	Tissue
23	Leo	Washington	Soda
24	Leo	Washington	Paper
25	Leo	Washington	Towel
26	Maxwell	New York	Tissue
27	Maxwell	New York	Soda
28	Maxwell	New York	Paper
29	Maxwell	New York	Towel
30	Maxwell	Washington	Tissue
31	Maxwell	Washington	Soda
32	Maxwell	Washington	Paper
33	Maxwell	Washington	Towel

In support of this Thread
https://excelfox.com/forum/showthrea...tiple-Criteria
and answer
https://excelfox.com/forum/showthrea...ll=1#post15046

After running Sub Arrays1()

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

_Row\^Col A B C D E

1 Sales Man Territory Dimension Sales Amt Cost

2 John New York Tissue 1000 200

3 John New York Soda 2050 1500

4 John New York Paper

5 John New York Towel

6 John Washington Tissue

7 John Washington Soda

8 John Washington Paper

9 John Washington Towel

10 Alfred New York Tissue 2000 500

11 Alfred New York Soda

12 Alfred New York Paper

13 Alfred New York Towel

14 Alfred Washington Tissue

15 Alfred Washington Soda 2100 700

16 Alfred Washington Paper

17 Alfred Washington Towel

18 Leo New York Tissue 3500 1500

19 Leo New York Soda

20 Leo New York Paper

21 Leo New York Towel

22 Leo Washington Tissue

23 Leo Washington Soda 200 100

24 Leo Washington Paper

25 Leo Washington Towel

26 Maxwell New York Tissue

27 Maxwell New York Soda

28 Maxwell New York Paper

29 Maxwell New York Towel

30 Maxwell Washington Tissue

31 Maxwell Washington Soda

32 Maxwell Washington Paper

33 Maxwell Washington Towel 1000 800

Worksheet: ResultVBA

_Row\^Col	A	B	C	D	E
1	Sales Man	Territory	Dimension	Sales Amt	Cost
2	John	New York	Tissue	1000	200
3	John	New York	Soda	2050	1500
4	John	New York	Paper
5	John	New York	Towel
6	John	Washington	Tissue
7	John	Washington	Soda
8	John	Washington	Paper
9	John	Washington	Towel
10	Alfred	New York	Tissue	2000	500
11	Alfred	New York	Soda
12	Alfred	New York	Paper
13	Alfred	New York	Towel
14	Alfred	Washington	Tissue
15	Alfred	Washington	Soda	2100	700
16	Alfred	Washington	Paper
17	Alfred	Washington	Towel
18	Leo	New York	Tissue	3500	1500
19	Leo	New York	Soda
20	Leo	New York	Paper
21	Leo	New York	Towel
22	Leo	Washington	Tissue
23	Leo	Washington	Soda	200	100
24	Leo	Washington	Paper
25	Leo	Washington	Towel
26	Maxwell	New York	Tissue
27	Maxwell	New York	Soda
28	Maxwell	New York	Paper
29	Maxwell	New York	Towel
30	Maxwell	Washington	Tissue
31	Maxwell	Washington	Soda
32	Maxwell	Washington	Paper
33	Maxwell	Washington	Towel	1000	800

Some extra clarifying info for this thread
https://excelfox.com/forum/showthrea...tiple-Criteria
and specifically this post
https://excelfox.com/forum/showthrea...5048#post15048

For this range with Helper column

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

_Row\^Col A B C D E F

1 Sales Man Territory Dimension Helper Column Sales Amt Cost

2 John New York Tissue John|New York|Tissue 1,000.00 200.00

3 Alfred Washington Soda Alfred|Washington|Soda 2,100.00 700.00

4 John New York Soda John|New York|Soda 2,050.00 1,500.00

5 Alfred New York Tissue Alfred|New York|Tissue 2,000.00 500.00

6 Leo Washington Soda Leo|Washington|Soda 200.00 100.00

7 Leo New York Tissue Leo|New York|Tissue 3,500.00 1,500.00

8 Maxwell Washington Towel Maxwell|Washington|Towel 1,000.00 800.00

Worksheet: Export

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

_Row\^Col
D

1

Helper Column

2

=A2&"|"&B2&"|"&C2

3

=A3&"|"&B3&"|"&C3

4

=A4&"|"&B4&"|"&C4

5

=A5&"|"&B5&"|"&C5

6

=A6&"|"&B6&"|"&C6

7

=A7&"|"&B7&"|"&C7

8

=A8&"|"&B8&"|"&C8

Worksheet: Export

Formula VLookUp

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

_Row\^Col
D

E

2

=IF(ISERROR(VLOOKUP(A2&"|"&B2&"|"&C2,Export!$D$2:$F$8,2,FALSE)),"",VLOOKUP(A2&"|"&B2&"|"&C2,Export!$D$2:$F$8,2,FALSE))

=IF(ISERROR(VLOOKUP(A2&"|"&B2&"|"&C2,Export!$D$2:$F$8,3,FALSE)),"",VLOOKUP(A2&"|"&B2&"|"&C2,Export!$D$2:$F$8,3,FALSE))

Worksheet: ResultVLookUp

Formula Index

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

_Row\^Col
D

E

2

=IF(ISERROR(INDEX(Export!$E$2:$E$8,MATCH(1,(ResultIndex!A2=Export!$A$2:$A$8)*(ResultIndex!B2=Export!$B$2:$B$8)*(ResultIndex!C2=Export!$C$2:$C$8),0),1)),"",INDEX(Export!$E$2:$E$8,MATCH(1,(ResultIndex!A2=Export!$A$2:$A$8)*(ResultIndex!B2=Export!$B$2:$B$8)*(ResultIndex!C2=Export!$C$2:$C$8),0),1))

=IF(ISERROR(INDEX(Export!$F$2:$F$8,MATCH(1,(ResultIndex!A2=Export!$A$2:$A$8)*(ResultIndex!B2=Export!$B$2:$B$8)*(ResultIndex!C2=Export!$C$2:$C$8),0),1)),"",INDEX(Export!$F$2:$F$8,MATCH(1,(ResultIndex!A2=Export!$A$2:$A$8)*(ResultIndex!B2=Export!$B$2:$B$8)*(ResultIndex!C2=Export!$C$2:$C$8),0),1))

Worksheet: ResultIndex

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

_Row\^Col
D

E

2

=IFERROR(INDEX(Export!$E$2:$E$8,MATCH(1,(ResultIndex2!A2=Export!$A$2:$A$8)*(ResultIndex2!B2=Export!$B$2:$B$8)*(ResultIndex2!C2=Export!$C$2:$C$8),0),1),"")

=IFERROR(INDEX(Export!$F$2:$F$8,MATCH(1,(ResultIndex2!A2=Export!$A$2:$A$8)*(ResultIndex2!B2=Export!$B$2:$B$8)*(ResultIndex2!C2=Export!$C$2:$C$8),0),1),"")

Worksheet: ResultIndex2

_Row\^Col	A	B	C	D	E	F
1	Sales Man	Territory	Dimension	Helper Column	Sales Amt	Cost
2	John	New York	Tissue	John\|New York\|Tissue	1,000.00	200.00
3	Alfred	Washington	Soda	Alfred\|Washington\|Soda	2,100.00	700.00
4	John	New York	Soda	John\|New York\|Soda	2,050.00	1,500.00
5	Alfred	New York	Tissue	Alfred\|New York\|Tissue	2,000.00	500.00
6	Leo	Washington	Soda	Leo\|Washington\|Soda	200.00	100.00
7	Leo	New York	Tissue	Leo\|New York\|Tissue	3,500.00	1,500.00
8	Maxwell	Washington	Towel	Maxwell\|Washington\|Towel	1,000.00	800.00

_Row\^Col	D
1	Helper Column
2	=A2&"\|"&B2&"\|"&C2
3	=A3&"\|"&B3&"\|"&C3
4	=A4&"\|"&B4&"\|"&C4
5	=A5&"\|"&B5&"\|"&C5
6	=A6&"\|"&B6&"\|"&C6
7	=A7&"\|"&B7&"\|"&C7
8	=A8&"\|"&B8&"\|"&C8

_Row\^Col	D	E
2	=IF(ISERROR(VLOOKUP(A2&"\|"&B2&"\|"&C2,Export!$D$2:$F$8,2,FALSE)),"",VLOOKUP(A2&"\|"&B2&"\|"&C2,Export!$D$2:$F$8,2,FALSE))	=IF(ISERROR(VLOOKUP(A2&"\|"&B2&"\|"&C2,Export!$D$2:$F$8,3,FALSE)),"",VLOOKUP(A2&"\|"&B2&"\|"&C2,Export!$D$2:$F$8,3,FALSE))

_Row\^Col	D	E
2	=IF(ISERROR(INDEX(Export!$E$2:$E$8,MATCH(1,(ResultIndex!A2=Export!$A$2:$A$8)(ResultIndex!B2=Export!$B$2:$B$8)(ResultIndex!C2=Export!$C$2:$C$8),0),1)),"",INDEX(Export!$E$2:$E$8,MATCH(1,(ResultIndex!A2=Export!$A$2:$A$8)(ResultIndex!B2=Export!$B$2:$B$8)(ResultIndex!C2=Export!$C$2:$C$8),0),1))	=IF(ISERROR(INDEX(Export!$F$2:$F$8,MATCH(1,(ResultIndex!A2=Export!$A$2:$A$8)(ResultIndex!B2=Export!$B$2:$B$8)(ResultIndex!C2=Export!$C$2:$C$8),0),1)),"",INDEX(Export!$F$2:$F$8,MATCH(1,(ResultIndex!A2=Export!$A$2:$A$8)(ResultIndex!B2=Export!$B$2:$B$8)(ResultIndex!C2=Export!$C$2:$C$8),0),1))

_Row\^Col	D	E
2	=IFERROR(INDEX(Export!$E$2:$E$8,MATCH(1,(ResultIndex2!A2=Export!$A$2:$A$8)(ResultIndex2!B2=Export!$B$2:$B$8)(ResultIndex2!C2=Export!$C$2:$C$8),0),1),"")	=IFERROR(INDEX(Export!$F$2:$F$8,MATCH(1,(ResultIndex2!A2=Export!$A$2:$A$8)(ResultIndex2!B2=Export!$B$2:$B$8)(ResultIndex2!C2=Export!$C$2:$C$8),0),1),"")

Some extra clarifying info for this thread
https://excelfox.com/forum/showthrea...tiple-Criteria
and specifically this post
https://excelfox.com/forum/showthrea...5048#post15048

For this range

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

_Row\^Col A B C D E

1 Sales Man Territory Dimension Sales Amt Cost

2 John New York Tissue 1,000.00 200.00

3 Alfred Washington Soda 2,100.00 700.00

4 John New York Soda 2,050.00 1,500.00

5 Alfred New York Tissue 2,000.00 500.00

6 Leo Washington Soda 200.00 100.00

7 Leo New York Tissue 3,500.00 1,500.00

8 Maxwell Washington Towel 1,000.00 800.00

Worksheet: Export1

Index Formulas

From P45cal

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

_Row\^Col
D

E

2

=IF(ISERROR(INDEX(Export1!D$1:D$9,MATCH($A2 & "¬" & $B2 & "¬" & $C2,Export1!$A$1:$A$9 & "¬" & Export1!$B$1:$B$9 & "¬" & Export1!$C$1:$C$9,0))),"",INDEX(Export1!D$1:D$9,MATCH($A2 & "¬" & $B2 & "¬" & $C2,Export1!$A$1:$A$9 & "¬" & Export1!$B$1:$B$9 & "¬" & Export1!$C$1:$C$9,0)))

=IF(ISERROR(INDEX(Export1!E$1:E$9,MATCH($A2 & "¬" & $B2 & "¬" & $C2,Export1!$A$1:$A$9 & "¬" & Export1!$B$1:$B$9 & "¬" & Export1!$C$1:$C$9,0))),"",INDEX(Export1!E$1:E$9,MATCH($A2 & "¬" & $B2 & "¬" & $C2,Export1!$A$1:$A$9 & "¬" & Export1!$B$1:$B$9 & "¬" & Export1!$C$1:$C$9,0)))

Worksheet: P45cal

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

_Row\^Col
D

E

2

=IFERROR(INDEX(Export1!D$1:D$9,MATCH($A2 & "¬" & $B2 & "¬" & $C2,Export1!$A$1:$A$9 & "¬" & Export1!$B$1:$B$9 & "¬" & Export1!$C$1:$C$9,0)),"")

=IFERROR(INDEX(Export1!E$1:E$9,MATCH($A2 & "¬" & $B2 & "¬" & $C2,Export1!$A$1:$A$9 & "¬" & Export1!$B$1:$B$9 & "¬" & Export1!$C$1:$C$9,0)),"")

Worksheet: P45cal1

From Alan ( DocAElstein )

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

_Row\^Col
D

E

2

=IF(ISERROR(INDEX(Export1!$D$2:$D$8,MATCH(1,(ResIndex!A2=Export1!$A$2:$A$8)*(ResIndex!B2=Export1!$B$2:$B$8)*(ResIndex!C2=Export1!$C$2:$C$8),0),1)),"",INDEX(Export1!$D$2:$D$8,MATCH(1,(ResIndex!A2=Export1!$A$2:$A$8)*(ResIndex!B2=Export1!$B$2:$B$8)*(ResIndex!C2=Export1!$C$2:$C$8),0),1))

=IF(ISERROR(INDEX(Export1!$E$2:$E$8,MATCH(1,(ResIndex!A2=Export1!$A$2:$A$8)*(ResIndex!B2=Export1!$B$2:$B$8)*(ResIndex!C2=Export1!$C$2:$C$8),0),1)),"",INDEX(Export1!$E$2:$E$8,MATCH(1,(ResIndex!A2=Export1!$A$2:$A$8)*(ResIndex!B2=Export1!$B$2:$B$8)*(ResIndex!C2=Export1!$C$2:$C$8),0),1))

Worksheet: ResIndex

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

_Row\^Col
D

E

2

=IFERROR(INDEX(Export1!$D$2:$D$8,MATCH(1,(ResIndex2!A2=Export1!$A$2:$A$8)*(ResIndex2!B2=Export1!$B$2:$B$8)*(ResIndex2!C2=Export1!$C$2:$C$8),0),1),"")

=IFERROR(INDEX(Export1!$E$2:$E$8,MATCH(1,(ResIndex2!A2=Export1!$A$2:$A$8)*(ResIndex2!B2=Export1!$B$2:$B$8)*(ResIndex2!C2=Export1!$C$2:$C$8),0),1),"")

Worksheet: ResIndex2

11-01-2020, 03:39 PM
DocAElstein

In suppot of this Thread
http://www.eileenslounge.com/viewtopic.php?f=30&t=35600

Code:

' http://www.eileenslounge.com/viewtopic.php?f=30&t=35600 Sub ConvertBytesToString1() Dim Ay() As Variant: Let Ay() = Array(89, 97, 115, 115, 101, 114) Dim Es As String Dim Spt() As String Let Spt() = Split(ChrW(1) & "Sp" & ChrW(2) & "Sp" & ChrW(3) & "Sp" & ChrW(4) & "Sp" & ChrW(5) & "Sp" & ChrW(6) & "Sp" & ChrW(7) & "Sp" & ChrW(8) & "Sp" & ChrW(9) & "Sp" & ChrW(10) & "Sp" & ChrW(11) & "Sp" & ChrW(12) & "Sp" & ChrW(13) & "Sp" & ChrW(14) & "Sp" & ChrW(15) & "Sp" & ChrW(16) & "Sp" & ChrW(17) & "Sp" & ChrW(18) & "Sp" & ChrW(19) & "Sp" & ChrW(20) & "Sp" & ChrW(21) & "Sp" & ChrW(22) & "Sp" & ChrW(23) & "Sp" & ChrW(24) & "Sp" & ChrW(25) & "Sp" & ChrW(26) & "Sp" & ChrW(27) & "Sp" & ChrW(28) & "Sp" & ChrW(29) & "Sp" & ChrW(30) & "Sp" & ChrW(31) & "Sp" & ChrW(32) & "Sp" & ChrW(33) & "Sp" & ChrW(34) & "Sp" & ChrW(35) & "Sp" & ChrW(36) & "Sp" & ChrW(37) & "Sp" & ChrW(38) & "Sp" & ChrW(39) & "Sp" & ChrW(40) & "Sp" & ChrW(41) & "Sp" & ChrW(42) & "Sp" & ChrW(43) & "Sp" & ChrW(44) & "Sp" & ChrW(45) & "Sp" & ChrW(46) & "Sp" & ChrW(47) & "Sp" & ChrW(48) & "Sp" & ChrW(49) & "Sp" & ChrW(50) & _ "Sp" & ChrW(51) & "Sp" & ChrW(52) & "Sp" & ChrW(53) & "Sp" & ChrW(54) & "Sp" & ChrW(55) & "Sp" & ChrW(56) & "Sp" & ChrW(57) & "Sp" & ChrW(58) & "Sp" & ChrW(59) & "Sp" & ChrW(60) & "Sp" & ChrW(61) & "Sp" & ChrW(62) & "Sp" & ChrW(63) & "Sp" & ChrW(64) & "Sp" & ChrW(65) & "Sp" & ChrW(66) & "Sp" & ChrW(67) & "Sp" & ChrW(68) & "Sp" & ChrW(69) & "Sp" & ChrW(70) & "Sp" & ChrW(71) & "Sp" & ChrW(72) & "Sp" & ChrW(73) & "Sp" & ChrW(74) & "Sp" & ChrW(75) & "Sp" & ChrW(76) & "Sp" & ChrW(77) & "Sp" & ChrW(78) & "Sp" & ChrW(79) & "Sp" & ChrW(80) & "Sp" & ChrW(81) & "Sp" & ChrW(82) & "Sp" & ChrW(83) & "Sp" & ChrW(84) & "Sp" & ChrW(85) & "Sp" & ChrW(86) & "Sp" & ChrW(87) & "Sp" & ChrW(88) & "Sp" & ChrW(89) & "Sp" & ChrW(90) & "Sp" & ChrW(91) & "Sp" & ChrW(92) & "Sp" & ChrW(93) & "Sp" & ChrW(94) & "Sp" & ChrW(95) & "Sp" & ChrW(96) & "Sp" & ChrW(97) & "Sp" & ChrW(98) & "Sp" & ChrW(99) & "Sp" & ChrW(100) & _ "Sp" & ChrW(101) & "Sp" & ChrW(102) & "Sp" & ChrW(103) & "Sp" & ChrW(104) & "Sp" & ChrW(105) & "Sp" & ChrW(106) & "Sp" & ChrW(107) & "Sp" & ChrW(108) & "Sp" & ChrW(109) & "Sp" & ChrW(110) & "Sp" & ChrW(111) & "Sp" & ChrW(112) & "Sp" & ChrW(113) & "Sp" & ChrW(114) & "Sp" & ChrW(115) & "Sp" & ChrW(116) & "Sp" & ChrW(117) & "Sp" & ChrW(118) & "Sp" & ChrW(119) & "Sp" & ChrW(120) & "Sp" & ChrW(121) & "Sp" & ChrW(122) & "Sp" & ChrW(123) & "Sp" & ChrW(124) & "Sp" & ChrW(125) & "Sp" & ChrW(126) & "Sp" & ChrW(127) & "Sp" & ChrW(128) & "Sp" & ChrW(129) & "Sp" & ChrW(130) & "Sp" & ChrW(131) & "Sp" & ChrW(132) & "Sp" & ChrW(133) & "Sp" & ChrW(134) & "Sp" & ChrW(135) & "Sp" & ChrW(136) & "Sp" & ChrW(137) & "Sp" & ChrW(138) & "Sp" & ChrW(139) & "Sp" & ChrW(140) & "Sp" & ChrW(141) & "Sp" & ChrW(142) & "Sp" & ChrW(143) & "Sp" & ChrW(144) & "Sp" & ChrW(145) & "Sp" & ChrW(146) & "Sp" & ChrW(147) & "Sp" & ChrW(148) & "Sp" & ChrW(149) & "Sp" & ChrW(150) & _ "Sp" & ChrW(151) & "Sp" & ChrW(152) & "Sp" & ChrW(153) & "Sp" & ChrW(154) & "Sp" & ChrW(155) & "Sp" & ChrW(156) & "Sp" & ChrW(157) & "Sp" & ChrW(158) & "Sp" & ChrW(159) & "Sp" & ChrW(160) & "Sp" & ChrW(161) & "Sp" & ChrW(162) & "Sp" & ChrW(163) & "Sp" & ChrW(164) & "Sp" & ChrW(165) & "Sp" & ChrW(166) & "Sp" & ChrW(167) & "Sp" & ChrW(168) & "Sp" & ChrW(169) & "Sp" & ChrW(170) & "Sp" & ChrW(171) & "Sp" & ChrW(172) & "Sp" & ChrW(173) & "Sp" & ChrW(174) & "Sp" & ChrW(175) & "Sp" & ChrW(176) & "Sp" & ChrW(177) & "Sp" & ChrW(178) & "Sp" & ChrW(179) & "Sp" & ChrW(180) & "Sp" & ChrW(181) & "Sp" & ChrW(182) & "Sp" & ChrW(183) & "Sp" & ChrW(184) & "Sp" & ChrW(185) & "Sp" & ChrW(186) & "Sp" & ChrW(187) & "Sp" & ChrW(188) & "Sp" & ChrW(189) & "Sp" & ChrW(190) & "Sp" & ChrW(191) & "Sp" & ChrW(192) & "Sp" & ChrW(193) & "Sp" & ChrW(194) & "Sp" & ChrW(195) & "Sp" & ChrW(196) & "Sp" & ChrW(197) & "Sp" & ChrW(198) & "Sp" & ChrW(199) & "Sp" & ChrW(200), "Sp") ' Let Range("A2").Resize(1, 200) = Spt() Let Es = Join(Application.Index(Spt(), 1, Ay), "") ' Or Let Es = Join(Application.Index(Split(ChrW(1) & "Sp" & ChrW(2) & "Sp" & ChrW(3) & "Sp" & ChrW(4) & "Sp" & ChrW(5) & "Sp" & ChrW(6) & "Sp" & ChrW(7) & "Sp" & ChrW(8) & "Sp" & ChrW(9) & "Sp" & ChrW(10) & "Sp" & ChrW(11) & "Sp" & ChrW(12) & "Sp" & ChrW(13) & "Sp" & ChrW(14) & "Sp" & ChrW(15) & "Sp" & ChrW(16) & "Sp" & ChrW(17) & "Sp" & ChrW(18) & "Sp" & ChrW(19) & "Sp" & ChrW(20) & "Sp" & ChrW(21) & "Sp" & ChrW(22) & "Sp" & ChrW(23) & "Sp" & ChrW(24) & "Sp" & ChrW(25) & "Sp" & ChrW(26) & "Sp" & ChrW(27) & "Sp" & ChrW(28) & "Sp" & ChrW(29) & "Sp" & ChrW(30) & "Sp" & ChrW(31) & "Sp" & ChrW(32) & "Sp" & ChrW(33) & "Sp" & ChrW(34) & "Sp" & ChrW(35) & "Sp" & ChrW(36) & "Sp" & ChrW(37) & "Sp" & ChrW(38) & "Sp" & ChrW(39) & "Sp" & ChrW(40) & "Sp" & ChrW(41) & "Sp" & ChrW(42) & "Sp" & ChrW(43) & "Sp" & ChrW(44) & "Sp" & ChrW(45) & "Sp" & ChrW(46) & "Sp" & ChrW(47) & "Sp" & ChrW(48) & "Sp" & ChrW(49) & "Sp" & ChrW(50) & _ "Sp" & ChrW(51) & "Sp" & ChrW(52) & "Sp" & ChrW(53) & "Sp" & ChrW(54) & "Sp" & ChrW(55) & "Sp" & ChrW(56) & "Sp" & ChrW(57) & "Sp" & ChrW(58) & "Sp" & ChrW(59) & "Sp" & ChrW(60) & "Sp" & ChrW(61) & "Sp" & ChrW(62) & "Sp" & ChrW(63) & "Sp" & ChrW(64) & "Sp" & ChrW(65) & "Sp" & ChrW(66) & "Sp" & ChrW(67) & "Sp" & ChrW(68) & "Sp" & ChrW(69) & "Sp" & ChrW(70) & "Sp" & ChrW(71) & "Sp" & ChrW(72) & "Sp" & ChrW(73) & "Sp" & ChrW(74) & "Sp" & ChrW(75) & "Sp" & ChrW(76) & "Sp" & ChrW(77) & "Sp" & ChrW(78) & "Sp" & ChrW(79) & "Sp" & ChrW(80) & "Sp" & ChrW(81) & "Sp" & ChrW(82) & "Sp" & ChrW(83) & "Sp" & ChrW(84) & "Sp" & ChrW(85) & "Sp" & ChrW(86) & "Sp" & ChrW(87) & "Sp" & ChrW(88) & "Sp" & ChrW(89) & "Sp" & ChrW(90) & "Sp" & ChrW(91) & "Sp" & ChrW(92) & "Sp" & ChrW(93) & "Sp" & ChrW(94) & "Sp" & ChrW(95) & "Sp" & ChrW(96) & "Sp" & ChrW(97) & "Sp" & ChrW(98) & "Sp" & ChrW(99) & "Sp" & ChrW(100) & _ "Sp" & ChrW(101) & "Sp" & ChrW(102) & "Sp" & ChrW(103) & "Sp" & ChrW(104) & "Sp" & ChrW(105) & "Sp" & ChrW(106) & "Sp" & ChrW(107) & "Sp" & ChrW(108) & "Sp" & ChrW(109) & "Sp" & ChrW(110) & "Sp" & ChrW(111) & "Sp" & ChrW(112) & "Sp" & ChrW(113) & "Sp" & ChrW(114) & "Sp" & ChrW(115) & "Sp" & ChrW(116) & "Sp" & ChrW(117) & "Sp" & ChrW(118) & "Sp" & ChrW(119) & "Sp" & ChrW(120) & "Sp" & ChrW(121) & "Sp" & ChrW(122) & "Sp" & ChrW(123) & "Sp" & ChrW(124) & "Sp" & ChrW(125) & "Sp" & ChrW(126) & "Sp" & ChrW(127) & "Sp" & ChrW(128) & "Sp" & ChrW(129) & "Sp" & ChrW(130) & "Sp" & ChrW(131) & "Sp" & ChrW(132) & "Sp" & ChrW(133) & "Sp" & ChrW(134) & "Sp" & ChrW(135) & "Sp" & ChrW(136) & "Sp" & ChrW(137) & "Sp" & ChrW(138) & "Sp" & ChrW(139) & "Sp" & ChrW(140) & "Sp" & ChrW(141) & "Sp" & ChrW(142) & "Sp" & ChrW(143) & "Sp" & ChrW(144) & "Sp" & ChrW(145) & "Sp" & ChrW(146) & "Sp" & ChrW(147) & "Sp" & ChrW(148) & "Sp" & ChrW(149) & "Sp" & ChrW(150) & _ "Sp" & ChrW(151) & "Sp" & ChrW(152) & "Sp" & ChrW(153) & "Sp" & ChrW(154) & "Sp" & ChrW(155) & "Sp" & ChrW(156) & "Sp" & ChrW(157) & "Sp" & ChrW(158) & "Sp" & ChrW(159) & "Sp" & ChrW(160) & "Sp" & ChrW(161) & "Sp" & ChrW(162) & "Sp" & ChrW(163) & "Sp" & ChrW(164) & "Sp" & ChrW(165) & "Sp" & ChrW(166) & "Sp" & ChrW(167) & "Sp" & ChrW(168) & "Sp" & ChrW(169) & "Sp" & ChrW(170) & "Sp" & ChrW(171) & "Sp" & ChrW(172) & "Sp" & ChrW(173) & "Sp" & ChrW(174) & "Sp" & ChrW(175) & "Sp" & ChrW(176) & "Sp" & ChrW(177) & "Sp" & ChrW(178) & "Sp" & ChrW(179) & "Sp" & ChrW(180) & "Sp" & ChrW(181) & "Sp" & ChrW(182) & "Sp" & ChrW(183) & "Sp" & ChrW(184) & "Sp" & ChrW(185) & "Sp" & ChrW(186) & "Sp" & ChrW(187) & "Sp" & ChrW(188) & "Sp" & ChrW(189) & "Sp" & ChrW(190) & "Sp" & ChrW(191) & "Sp" & ChrW(192) & "Sp" & ChrW(193) & "Sp" & ChrW(194) & "Sp" & ChrW(195) & "Sp" & ChrW(196) & "Sp" & ChrW(197) & "Sp" & ChrW(198) & "Sp" & ChrW(199) & "Sp" & ChrW(200), "Sp"), 1, Ay), "") End Sub
11-01-2020, 03:41 PM
DocAElstein

In support of this Thread
http://www.eileenslounge.com/viewtopic.php?f=30&t=35600

Code:

Sub ConvertBytesToString2() Dim Es As String Dim Spt() As String Let Spt() = Split(ChrW(1) & "Sp" & ChrW(2) & "Sp" & ChrW(3) & "Sp" & ChrW(4) & "Sp" & ChrW(5) & "Sp" & ChrW(6) & "Sp" & ChrW(7) & "Sp" & ChrW(8) & "Sp" & ChrW(9) & "Sp" & ChrW(10) & "Sp" & ChrW(11) & "Sp" & ChrW(12) & "Sp" & ChrW(13) & "Sp" & ChrW(14) & "Sp" & ChrW(15) & "Sp" & ChrW(16) & "Sp" & ChrW(17) & "Sp" & ChrW(18) & "Sp" & ChrW(19) & "Sp" & ChrW(20) & "Sp" & ChrW(21) & "Sp" & ChrW(22) & "Sp" & ChrW(23) & "Sp" & ChrW(24) & "Sp" & ChrW(25) & "Sp" & ChrW(26) & "Sp" & ChrW(27) & "Sp" & ChrW(28) & "Sp" & ChrW(29) & "Sp" & ChrW(30) & "Sp" & ChrW(31) & "Sp" & ChrW(32) & "Sp" & ChrW(33) & "Sp" & ChrW(34) & "Sp" & ChrW(35) & "Sp" & ChrW(36) & "Sp" & ChrW(37) & "Sp" & ChrW(38) & "Sp" & ChrW(39) & "Sp" & ChrW(40) & "Sp" & ChrW(41) & "Sp" & ChrW(42) & "Sp" & ChrW(43) & "Sp" & ChrW(44) & "Sp" & ChrW(45) & "Sp" & ChrW(46) & "Sp" & ChrW(47) & "Sp" & ChrW(48) & "Sp" & ChrW(49) & "Sp" & ChrW(50) & _ "Sp" & ChrW(51) & "Sp" & ChrW(52) & "Sp" & ChrW(53) & "Sp" & ChrW(54) & "Sp" & ChrW(55) & "Sp" & ChrW(56) & "Sp" & ChrW(57) & "Sp" & ChrW(58) & "Sp" & ChrW(59) & "Sp" & ChrW(60) & "Sp" & ChrW(61) & "Sp" & ChrW(62) & "Sp" & ChrW(63) & "Sp" & ChrW(64) & "Sp" & ChrW(65) & "Sp" & ChrW(66) & "Sp" & ChrW(67) & "Sp" & ChrW(68) & "Sp" & ChrW(69) & "Sp" & ChrW(70) & "Sp" & ChrW(71) & "Sp" & ChrW(72) & "Sp" & ChrW(73) & "Sp" & ChrW(74) & "Sp" & ChrW(75) & "Sp" & ChrW(76) & "Sp" & ChrW(77) & "Sp" & ChrW(78) & "Sp" & ChrW(79) & "Sp" & ChrW(80) & "Sp" & ChrW(81) & "Sp" & ChrW(82) & "Sp" & ChrW(83) & "Sp" & ChrW(84) & "Sp" & ChrW(85) & "Sp" & ChrW(86) & "Sp" & ChrW(87) & "Sp" & ChrW(88) & "Sp" & ChrW(89) & "Sp" & ChrW(90) & "Sp" & ChrW(91) & "Sp" & ChrW(92) & "Sp" & ChrW(93) & "Sp" & ChrW(94) & "Sp" & ChrW(95) & "Sp" & ChrW(96) & "Sp" & ChrW(97) & "Sp" & ChrW(98) & "Sp" & ChrW(99) & "Sp" & ChrW(100) & _ "Sp" & ChrW(101) & "Sp" & ChrW(102) & "Sp" & ChrW(103) & "Sp" & ChrW(104) & "Sp" & ChrW(105) & "Sp" & ChrW(106) & "Sp" & ChrW(107) & "Sp" & ChrW(108) & "Sp" & ChrW(109) & "Sp" & ChrW(110) & "Sp" & ChrW(111) & "Sp" & ChrW(112) & "Sp" & ChrW(113) & "Sp" & ChrW(114) & "Sp" & ChrW(115) & "Sp" & ChrW(116) & "Sp" & ChrW(117) & "Sp" & ChrW(118) & "Sp" & ChrW(119) & "Sp" & ChrW(120) & "Sp" & ChrW(121) & "Sp" & ChrW(122) & "Sp" & ChrW(123) & "Sp" & ChrW(124) & "Sp" & ChrW(125) & "Sp" & ChrW(126) & "Sp" & ChrW(127) & "Sp" & ChrW(128) & "Sp" & ChrW(129) & "Sp" & ChrW(130) & "Sp" & ChrW(131) & "Sp" & ChrW(132) & "Sp" & ChrW(133) & "Sp" & ChrW(134) & "Sp" & ChrW(135) & "Sp" & ChrW(136) & "Sp" & ChrW(137) & "Sp" & ChrW(138) & "Sp" & ChrW(139) & "Sp" & ChrW(140) & "Sp" & ChrW(141) & "Sp" & ChrW(142) & "Sp" & ChrW(143) & "Sp" & ChrW(144) & "Sp" & ChrW(145) & "Sp" & ChrW(146) & "Sp" & ChrW(147) & "Sp" & ChrW(148) & "Sp" & ChrW(149) & "Sp" & ChrW(150) & _ "Sp" & ChrW(151) & "Sp" & ChrW(152) & "Sp" & ChrW(153) & "Sp" & ChrW(154) & "Sp" & ChrW(155) & "Sp" & ChrW(156) & "Sp" & ChrW(157) & "Sp" & ChrW(158) & "Sp" & ChrW(159) & "Sp" & ChrW(160) & "Sp" & ChrW(161) & "Sp" & ChrW(162) & "Sp" & ChrW(163) & "Sp" & ChrW(164) & "Sp" & ChrW(165) & "Sp" & ChrW(166) & "Sp" & ChrW(167) & "Sp" & ChrW(168) & "Sp" & ChrW(169) & "Sp" & ChrW(170) & "Sp" & ChrW(171) & "Sp" & ChrW(172) & "Sp" & ChrW(173) & "Sp" & ChrW(174) & "Sp" & ChrW(175) & "Sp" & ChrW(176) & "Sp" & ChrW(177) & "Sp" & ChrW(178) & "Sp" & ChrW(179) & "Sp" & ChrW(180) & "Sp" & ChrW(181) & "Sp" & ChrW(182) & "Sp" & ChrW(183) & "Sp" & ChrW(184) & "Sp" & ChrW(185) & "Sp" & ChrW(186) & "Sp" & ChrW(187) & "Sp" & ChrW(188) & "Sp" & ChrW(189) & "Sp" & ChrW(190) & "Sp" & ChrW(191) & "Sp" & ChrW(192) & "Sp" & ChrW(193) & "Sp" & ChrW(194) & "Sp" & ChrW(195) & "Sp" & ChrW(196) & "Sp" & ChrW(197) & "Sp" & ChrW(198) & "Sp" & ChrW(199) & "Sp" & ChrW(200), "Sp") Let Es = Join(Application.Index(Spt(), 1, Evaluate("={89, 97, 115, 115, 101, 114}")), "") ' Or Let Es = Join(Application.Index(Split(ChrW(1) & "Sp" & ChrW(2) & "Sp" & ChrW(3) & "Sp" & ChrW(4) & "Sp" & ChrW(5) & "Sp" & ChrW(6) & "Sp" & ChrW(7) & "Sp" & ChrW(8) & "Sp" & ChrW(9) & "Sp" & ChrW(10) & "Sp" & ChrW(11) & "Sp" & ChrW(12) & "Sp" & ChrW(13) & "Sp" & ChrW(14) & "Sp" & ChrW(15) & "Sp" & ChrW(16) & "Sp" & ChrW(17) & "Sp" & ChrW(18) & "Sp" & ChrW(19) & "Sp" & ChrW(20) & "Sp" & ChrW(21) & "Sp" & ChrW(22) & "Sp" & ChrW(23) & "Sp" & ChrW(24) & "Sp" & ChrW(25) & "Sp" & ChrW(26) & "Sp" & ChrW(27) & "Sp" & ChrW(28) & "Sp" & ChrW(29) & "Sp" & ChrW(30) & "Sp" & ChrW(31) & "Sp" & ChrW(32) & "Sp" & ChrW(33) & "Sp" & ChrW(34) & "Sp" & ChrW(35) & "Sp" & ChrW(36) & "Sp" & ChrW(37) & "Sp" & ChrW(38) & "Sp" & ChrW(39) & "Sp" & ChrW(40) & "Sp" & ChrW(41) & "Sp" & ChrW(42) & "Sp" & ChrW(43) & "Sp" & ChrW(44) & "Sp" & ChrW(45) & "Sp" & ChrW(46) & "Sp" & ChrW(47) & "Sp" & ChrW(48) & "Sp" & ChrW(49) & "Sp" & ChrW(50) & _ "Sp" & ChrW(51) & "Sp" & ChrW(52) & "Sp" & ChrW(53) & "Sp" & ChrW(54) & "Sp" & ChrW(55) & "Sp" & ChrW(56) & "Sp" & ChrW(57) & "Sp" & ChrW(58) & "Sp" & ChrW(59) & "Sp" & ChrW(60) & "Sp" & ChrW(61) & "Sp" & ChrW(62) & "Sp" & ChrW(63) & "Sp" & ChrW(64) & "Sp" & ChrW(65) & "Sp" & ChrW(66) & "Sp" & ChrW(67) & "Sp" & ChrW(68) & "Sp" & ChrW(69) & "Sp" & ChrW(70) & "Sp" & ChrW(71) & "Sp" & ChrW(72) & "Sp" & ChrW(73) & "Sp" & ChrW(74) & "Sp" & ChrW(75) & "Sp" & ChrW(76) & "Sp" & ChrW(77) & "Sp" & ChrW(78) & "Sp" & ChrW(79) & "Sp" & ChrW(80) & "Sp" & ChrW(81) & "Sp" & ChrW(82) & "Sp" & ChrW(83) & "Sp" & ChrW(84) & "Sp" & ChrW(85) & "Sp" & ChrW(86) & "Sp" & ChrW(87) & "Sp" & ChrW(88) & "Sp" & ChrW(89) & "Sp" & ChrW(90) & "Sp" & ChrW(91) & "Sp" & ChrW(92) & "Sp" & ChrW(93) & "Sp" & ChrW(94) & "Sp" & ChrW(95) & "Sp" & ChrW(96) & "Sp" & ChrW(97) & "Sp" & ChrW(98) & "Sp" & ChrW(99) & "Sp" & ChrW(100) & _ "Sp" & ChrW(101) & "Sp" & ChrW(102) & "Sp" & ChrW(103) & "Sp" & ChrW(104) & "Sp" & ChrW(105) & "Sp" & ChrW(106) & "Sp" & ChrW(107) & "Sp" & ChrW(108) & "Sp" & ChrW(109) & "Sp" & ChrW(110) & "Sp" & ChrW(111) & "Sp" & ChrW(112) & "Sp" & ChrW(113) & "Sp" & ChrW(114) & "Sp" & ChrW(115) & "Sp" & ChrW(116) & "Sp" & ChrW(117) & "Sp" & ChrW(118) & "Sp" & ChrW(119) & "Sp" & ChrW(120) & "Sp" & ChrW(121) & "Sp" & ChrW(122) & "Sp" & ChrW(123) & "Sp" & ChrW(124) & "Sp" & ChrW(125) & "Sp" & ChrW(126) & "Sp" & ChrW(127) & "Sp" & ChrW(128) & "Sp" & ChrW(129) & "Sp" & ChrW(130) & "Sp" & ChrW(131) & "Sp" & ChrW(132) & "Sp" & ChrW(133) & "Sp" & ChrW(134) & "Sp" & ChrW(135) & "Sp" & ChrW(136) & "Sp" & ChrW(137) & "Sp" & ChrW(138) & "Sp" & ChrW(139) & "Sp" & ChrW(140) & "Sp" & ChrW(141) & "Sp" & ChrW(142) & "Sp" & ChrW(143) & "Sp" & ChrW(144) & "Sp" & ChrW(145) & "Sp" & ChrW(146) & "Sp" & ChrW(147) & "Sp" & ChrW(148) & "Sp" & ChrW(149) & "Sp" & ChrW(150) & _ "Sp" & ChrW(151) & "Sp" & ChrW(152) & "Sp" & ChrW(153) & "Sp" & ChrW(154) & "Sp" & ChrW(155) & "Sp" & ChrW(156) & "Sp" & ChrW(157) & "Sp" & ChrW(158) & "Sp" & ChrW(159) & "Sp" & ChrW(160) & "Sp" & ChrW(161) & "Sp" & ChrW(162) & "Sp" & ChrW(163) & "Sp" & ChrW(164) & "Sp" & ChrW(165) & "Sp" & ChrW(166) & "Sp" & ChrW(167) & "Sp" & ChrW(168) & "Sp" & ChrW(169) & "Sp" & ChrW(170) & "Sp" & ChrW(171) & "Sp" & ChrW(172) & "Sp" & ChrW(173) & "Sp" & ChrW(174) & "Sp" & ChrW(175) & "Sp" & ChrW(176) & "Sp" & ChrW(177) & "Sp" & ChrW(178) & "Sp" & ChrW(179) & "Sp" & ChrW(180) & "Sp" & ChrW(181) & "Sp" & ChrW(182) & "Sp" & ChrW(183) & "Sp" & ChrW(184) & "Sp" & ChrW(185) & "Sp" & ChrW(186) & "Sp" & ChrW(187) & "Sp" & ChrW(188) & "Sp" & ChrW(189) & "Sp" & ChrW(190) & "Sp" & ChrW(191) & "Sp" & ChrW(192) & "Sp" & ChrW(193) & "Sp" & ChrW(194) & "Sp" & ChrW(195) & "Sp" & ChrW(196) & "Sp" & ChrW(197) & "Sp" & ChrW(198) & "Sp" & ChrW(199) & "Sp" & ChrW(200), "Sp"), 1, Evaluate("={89, 97, 115, 115, 101, 114}")), "") End Sub
11-01-2020, 03:45 PM
DocAElstein

In support of this Thread
http://www.eileenslounge.com/viewtopic.php?f=30&t=35600

Code:

' If I don't need all characters, then I can simplify a bit Sub ConvertBytesToString3() Dim Es As String Dim Spt() As String Let Spt() = Split(ChrW(65) & "Sp" & ChrW(66) & "Sp" & ChrW(67) & "Sp" & ChrW(68) & "Sp" & ChrW(69) & "Sp" & ChrW(70) & "Sp" & ChrW(71) & "Sp" & ChrW(72) & "Sp" & ChrW(73) & "Sp" & ChrW(74) & "Sp" & ChrW(75) & "Sp" & ChrW(76) & "Sp" & ChrW(77) & "Sp" & ChrW(78) & "Sp" & ChrW(79) & "Sp" & ChrW(80) & "Sp" & ChrW(81) & "Sp" & ChrW(82) & "Sp" & ChrW(83) & "Sp" & ChrW(84) & "Sp" & ChrW(85) & "Sp" & ChrW(86) & "Sp" & ChrW(87) & "Sp" & ChrW(88) & "Sp" & ChrW(89) & "Sp" & ChrW(90) & "Sp" & ChrW(91) & "Sp" & ChrW(92) & "Sp" & ChrW(93) & "Sp" & ChrW(94) & "Sp" & ChrW(95) & "Sp" & ChrW(96) & "Sp" & ChrW(97) & "Sp" & ChrW(98) & "Sp" & ChrW(99) & "Sp" & ChrW(100) & _ "Sp" & ChrW(101) & "Sp" & ChrW(102) & "Sp" & ChrW(103) & "Sp" & ChrW(104) & "Sp" & ChrW(105) & "Sp" & ChrW(106) & "Sp" & ChrW(107) & "Sp" & ChrW(108) & "Sp" & ChrW(109) & "Sp" & ChrW(110) & "Sp" & ChrW(111) & "Sp" & ChrW(112) & "Sp" & ChrW(113) & "Sp" & ChrW(114) & "Sp" & ChrW(115) & "Sp" & ChrW(116) & "Sp" & ChrW(117) & "Sp" & ChrW(118) & "Sp" & ChrW(119) & "Sp" & ChrW(120) & "Sp" & ChrW(121) & "Sp" & ChrW(122) & "Sp" & ChrW(123) & "Sp" & ChrW(124) & "Sp" & ChrW(125) & "Sp" & ChrW(126), "Sp") Let Es = Join(Application.Index(Spt(), 1, Evaluate("={89, 97, 115, 115, 101, 114}-64")), "") ' Or Let Es = Join(Application.Index(Split(ChrW(65) & "Sp" & ChrW(66) & "Sp" & ChrW(67) & "Sp" & ChrW(68) & "Sp" & ChrW(69) & "Sp" & ChrW(70) & "Sp" & ChrW(71) & "Sp" & ChrW(72) & "Sp" & ChrW(73) & "Sp" & ChrW(74) & "Sp" & ChrW(75) & "Sp" & ChrW(76) & "Sp" & ChrW(77) & "Sp" & ChrW(78) & "Sp" & ChrW(79) & "Sp" & ChrW(80) & "Sp" & ChrW(81) & "Sp" & ChrW(82) & "Sp" & ChrW(83) & "Sp" & ChrW(84) & "Sp" & ChrW(85) & "Sp" & ChrW(86) & "Sp" & ChrW(87) & "Sp" & ChrW(88) & "Sp" & ChrW(89) & "Sp" & ChrW(90) & "Sp" & ChrW(91) & "Sp" & ChrW(92) & "Sp" & ChrW(93) & "Sp" & ChrW(94) & "Sp" & ChrW(95) & "Sp" & ChrW(96) & "Sp" & ChrW(97) & "Sp" & ChrW(98) & "Sp" & ChrW(99) & "Sp" & ChrW(100) & _ "Sp" & ChrW(101) & "Sp" & ChrW(102) & "Sp" & ChrW(103) & "Sp" & ChrW(104) & "Sp" & ChrW(105) & "Sp" & ChrW(106) & "Sp" & ChrW(107) & "Sp" & ChrW(108) & "Sp" & ChrW(109) & "Sp" & ChrW(110) & "Sp" & ChrW(111) & "Sp" & ChrW(112) & "Sp" & ChrW(113) & "Sp" & ChrW(114) & "Sp" & ChrW(115) & "Sp" & ChrW(116) & "Sp" & ChrW(117) & "Sp" & ChrW(118) & "Sp" & ChrW(119) & "Sp" & ChrW(120) & "Sp" & ChrW(121) & "Sp" & ChrW(122) & "Sp" & ChrW(123) & "Sp" & ChrW(124) & "Sp" & ChrW(125) & "Sp" & ChrW(126), "Sp"), 1, Evaluate("={89, 97, 115, 115, 101, 114}-64")), "") End Sub Sub ConvertBytesToString4() Dim Es As String Dim Splat() As Variant Let Splat() = Array(ChrW(65), ChrW(66), ChrW(67), ChrW(68), ChrW(69), ChrW(70), ChrW(71), ChrW(72), ChrW(73), ChrW(74), ChrW(75), ChrW(76), ChrW(77), ChrW(78), ChrW(79), ChrW(80), ChrW(81), ChrW(82), ChrW(83), ChrW(84), ChrW(85), ChrW(86), ChrW(87), ChrW(88), ChrW(89), ChrW(90), ChrW(91), ChrW(92), ChrW(93), ChrW(94), ChrW(95), ChrW(96), ChrW(97), ChrW(98), ChrW(99), ChrW(100), ChrW(101), ChrW(102), ChrW(103), ChrW(104), ChrW(105), ChrW(106), ChrW(107), ChrW(108), ChrW(109), ChrW(110), ChrW(111), ChrW(112), ChrW(113), ChrW(114), ChrW(115), ChrW(116), ChrW(117), ChrW(118), ChrW(119), ChrW(120), ChrW(121), ChrW(122), ChrW(123), ChrW(124), ChrW(125), ChrW(126)) Let Es = Join(Application.Index(Splat(), 1, Evaluate("={89, 97, 115, 115, 101, 114}-64")), "") ' Or Let Es = Join(Application.Index(Array(ChrW(65), ChrW(66), ChrW(67), ChrW(68), ChrW(69), ChrW(70), ChrW(71), ChrW(72), ChrW(73), ChrW(74), ChrW(75), ChrW(76), ChrW(77), ChrW(78), ChrW(79), ChrW(80), ChrW(81), ChrW(82), ChrW(83), ChrW(84), ChrW(85), ChrW(86), ChrW(87), ChrW(88), ChrW(89), ChrW(90), ChrW(91), ChrW(92), ChrW(93), ChrW(94), ChrW(95), ChrW(96), ChrW(97), ChrW(98), ChrW(99), ChrW(100), ChrW(101), ChrW(102), ChrW(103), ChrW(104), ChrW(105), ChrW(106), ChrW(107), ChrW(108), ChrW(109), ChrW(110), ChrW(111), ChrW(112), ChrW(113), ChrW(114), ChrW(115), ChrW(116), ChrW(117), ChrW(118), ChrW(119), ChrW(120), ChrW(121), ChrW(122), ChrW(123), ChrW(124), ChrW(125), ChrW(126)), 1, Evaluate("={89, 97, 115, 115, 101, 114}-64")), "") End Sub
11-01-2020, 04:59 PM
DocAElstein

In support of this Thread
http://www.eileenslounge.com/viewtopic.php?f=30&t=35600

Code:

Sub MakeSomeStringsToCopyAndPasteIntoACode() Dim CodeText As String Dim Cnt As Long Rem 1 For an ASCII array from Split '1a) Spaces : Note: PROBLEM* If you use the Split way, then best is to avoid using a single character as the separator. Otherwise you may have problems if you want that character in your Horizontal Array of ASCII characters because it will be seen as a separator for Split. This means that you will not get that character in your list. Instead you will have 2 extra empty elements in your array, and all characters after where the character ( here the space) should have been will appear offset by one place to the right in the horizontal array For Cnt = 1 To 200 Let CodeText = CodeText & " & "" "" & ChrW(" & Cnt & ")" Next Cnt Let CodeText = Mid(CodeText, 10) ' take of first 9 bits of Space&Space"Space"Space&Space Debug.Print CodeText Debug.Print Let CodeText = "" ' Empty so that i can use the varable again below '1b) Use any 2 characters as the seperator to avoid PROBLEM* For Cnt = 1 To 200 Let CodeText = CodeText & " & ""Sp"" & ChrW(" & Cnt & ")" Next Cnt Let CodeText = Mid(CodeText, 11) ' take of first 10 bits of Space&Space"Sp"Space&Space Debug.Print CodeText Debug.Print Rem 2 For ASCII array from VBA Array( ) function Let CodeText = "" ' Empty so that i can use the varable again below For Cnt = 1 To 200 Let CodeText = CodeText & ", ChrW(" & Cnt & ")" Next Cnt Let CodeText = Mid(CodeText, 3) ' take off the first two characters " ," Debug.Print CodeText Debug.Print End Sub ' http://www.eileenslounge.com/viewtopic.php?f=30&t=35600
11-18-2020, 01:48 PM
DocAElstein

Test post for later use
11-30-2020, 02:47 PM
DocAElstein

Some extra notes for a few Posts
http://www.eileenslounge.com/viewtop...278892#p278892
https://www.myonlinetraininghub.com/...andling-in-vba
https://excelfox.com/forum/showthrea...GoRoT-N0Nula-1
https://excelfox.com/forum/showthrea...0559#post10559

On Error GoTo -1 is not equivalent of using Err.Clear. It does ( also) clear the error object, (equivalent of using Err.Clear ).
On Error GoTo -1 takes Excel out of the so called “exception state”. It also does clear the Err object registers, (equivalent of using Err.Clear ). But the later is secondary to its main function of “clearing the exception”.
The next macro has 3 identical erroring code lines . Just before each error we have an error handler, which we might expect would trap the error following it . All three error handlers are similar and are of the type On Error GoTo [LABEL] But we find that only the first two error handlers work….
In this macro the first and the second error handlers, of the type On Error GoTo [LABEL] are enabled, and so when an error occurs the coding jumps to the appropriate Label
The second Error handler would not have worked, that is to say the second error would not have been trapped without the code line of On Error GoTo -1 . On Error GoTo -1 has cleared the exception state.
The third error handler, also of the type On Error GoTo [LABEL], does not work. It does not work, that is to say the error is not trapped , because we are in the exception state. One of the characteristics of the exception state is that any attempt to enable an error handler will be ignored. Another characteristic of the exception state is that any enabled error handler, ( in this case the second one ) , will also be ignored.
It is also sometimes said in this situation that the second error handler is active and is still handling the second error. It cannot handle another error , and any further errors will be handled by the VBA default error handler

Code:

Sub OnErrorGoToMinus1_takes_Excel_out_of_the_so_called_exception_state() ' It also does clear the Err object registers, (equivalent of using Err.Clear ). But the later is secondary to its main function of "clearing the exception" Dim Rslt As Double On Error GoTo ErrHndlr1 Let Rslt = 1 / 0 ' This error gets trapped by ErrHndlr1 MsgBox Prompt:="You will never see this", Title:="You will never see this" Exit Sub ' You will never come here in this demo macro, but its good practice to get in the habit of always doing this exit sub ErrHndlr1: Debug.Print Err.Number & vbCr & vbLf & Err.Description ' 11 Division durch Null On Error GoTo -1 ' the next line will give us no error infomation because the On Error GoTo -1 has cleared the Err object registers Debug.Print Err.Number & vbCr & vbLf & Err.Description ' 0 On Error GoTo ErrHndlr2 ' the main function of On Error GoTo -1 is to "clear the exception" which means this second error hanhler will work Let Rslt = 1 / 0 ' This error gets trapped by ErrHndlr2 MsgBox Prompt:="You will never see this", Title:="You will never see this" Exit Sub ' You will never come here in this demo macro, but its good practice to get in the habit of always doing this exit sub ErrHndlr2: Debug.Print Err.Number & vbCr & vbLf & Err.Description ' 11 Division durch Null ' I will not do On Error GoTo -1 and see what happens... On Error GoTo ErrHndlr3 Let Rslt = 1 / 0 ' This will be handled by the VBA default error handler: The error will not be trapped by the second error handler , ErrHndlr2 MsgBox Prompt:="You will never see this", Title:="You will never see this" Exit Sub ' You will never come here in this demo macro, but its good practice to get in the habit of always doing this exit sub ErrHndlr3: ' You will never come here. The third error is not trapped: It will be handled by the VBA default error handler End Sub

The following other error things also , in addition to their main function, clear the Err object registers –
_ On Error GoTo 0 ,
_ changing the error handler
_ Resume, ( Resume; Resume Next; Resume [label] )
-.....see next post
11-30-2020, 02:47 PM
DocAElstein

Some extra notes for a few Posts
http://www.eileenslounge.com/viewtop...278892#p278892
https://www.myonlinetraininghub.com/...andling-in-vba
https://excelfox.com/forum/showthrea...GoRoT-N0Nula-1
https://excelfox.com/forum/showthrea...0559#post10559

_.....continued from last post

The following other error things also , in addition to their main function, clear the Err object registers –
_ On Error GoTo 0 ,
_ changing the error handler
_ Resume, ( Resume; Resume Next; Resume [label] ) ,
Here are 5 demos
1x On Error GoTo 0
1x changing the error handler
3x Resume, ( 1xResume; 1xResume Next; 1xResume [label] )

Code:

Sub OnErrorGoTo0ClearsErr() ' _ On Error GoTo 0 Dim Rslt As Double On Error Resume Next ' In simple terms this allows the code to contiunue as if no error had occured. It is not quite that simple, for example, the Err and Error are filled Debug.Print Err & vbCr & vbLf & Error ' gives 0 The default Err property is the error number, so in this situation Err is taken as Err.number The exact working of Error is unclear, but if an error occurs it seems to do a few things, and one of them is that it returns the error description Let Rslt = 1 / 0 Debug.Print Err & vbCr & vbLf & Error ' gives 11 Division durch Null On Error GoTo 0 ' The main purpose of this is to disable our error handler and return to the default VBA error handler. As a secodary function it seems to clear the Err registers Debug.Print Err & vbCr & vbLf & Error ' gives 0 End Sub Sub ChangingTheErrorHandlerClearsErr() ' _ changing the error handler Dim Rslt As Double On Error Resume Next ' In simple terms this allows the code to contiunue as if no error had occured. It is not quite that simple, for example, the Err and Error are filled Debug.Print Err & vbCr & vbLf & Error ' gives 0 The default Err property is the error number, so in this situation Err is taken as Err.number The exact working of Error is unclear, but if an error occurs it seems to do a few things, and one of them is that it returns the error description Let Rslt = 1 / 0 Debug.Print Err & vbCr & vbLf & Error ' gives 11 Division durch Null On Error Resume Next Debug.Print Err & vbCr & vbLf & Error ' gives 0 because I have changed the error handler , ( admitedly in this case changed it to the same type ) Let Rslt = 1 / 0 Debug.Print Err & vbCr & vbLf & Error ' gives 11 Division durch Null On Error GoTo Bed Debug.Print Err & vbCr & vbLf & Error ' gives 0 because I have changed the error handler Let Rslt = 1 / 0 Exit Sub ' I don't need this since i never come here, but its good practice to get in the habit of having this above a typical Error handling code section. Bed: Debug.Print Err & vbCr & vbLf & Error ' gives 11 Division durch Null End Sub Sub Resume_ClearsErr() ' _ Resume, ( Resume ) Dim Rslt As Double, Demonostrator As Long On Error GoTo ErrHndler ' In simple terms this tells VBA to go the the label, ErrHndler Note however that if an error causes me to go there, then I will then be in the exception state. Debug.Print Err & vbCr & vbLf & Error ' gives 0 The default Err property is the error number, so in this situation Err is taken as Err.number The exact working of Error is unclear, but if an error occurs it seems to do a few things, and one of them is that it returns the error description Let Rslt = 1 / Demonostrator ' Initially this causes me to go to ErrHndler but then the Resume brings me back to re try this code line Debug.Print Err & vbCr & vbLf & Error ' gives 0 The Resume cleared the Err registers Exit Sub ErrHndler: ' Start of a what is commonly called an "error handling code section" Debug.Print Err & vbCr & vbLf & Error ' gives 11 Division durch Null The Err register is always filled in all situatiuons when an error occurs, regardless of what error handler is or isn't in place. Let Demonostrator = 1 ' It is important to cure the problem causing the error here, or otherwise the next code line will cause an infinite loop because the next code line instructs VBA to go back and try the erroring code line again. Note also that the Resume in the next code line also clears the error exception and clears the Err registers Resume ' This clears the exception, clears the Err registers, and instructs VBA to go back to the code line that errored and try again. Because it instructs VBA to go back and try the erroring code line again, It is important to cure the problem causing the error before this code line, or else we will have an infinite loop End Sub Sub Resume_Next_ClearsErr() ' 'Resume, ( Resume Next ) Dim Rslt As Double On Error GoTo ErrHndler ' In simple terms this tells VBA to go the the label, ErrHndler Note however that if an error causes me to go there, then I will then be in the exception state. Debug.Print Err & vbCr & vbLf & Error ' gives 0 The default Err property is the error number, so in this situation Err is taken as Err.number The exact working of Error is unclear, but if an error occurs it seems to do a few things, and one of them is that it returns the error description Let Rslt = 1 / 0 ' This causes me to go to ErrHndler The Resume Next brings me back to just after this code line Debug.Print Err & vbCr & vbLf & Error ' gives 0 The Resume Next cleared the Err registers Exit Sub ErrHndler: ' Start of a what is commonly called an "error handling code section" Debug.Print Err & vbCr & vbLf & Error ' gives 11 Division durch Null The Err register is always filled in all situatiuons when an error occurs, regardless of what error handler is or isn't in place. Resume Next ' This clears the exception, clears the Err registers, and instructs VBA to go back to the code line just after that code line that errored End Sub Sub Resume_LABEL_ClearsErr() ' 'Resume, ( Resume [label] ) Dim Rslt As Double On Error GoTo ErrHndler ' In simple terms this tells VBA to go the the label, ErrHndler Note however that if an error causes me to go there, then I will then be in the exception state. Debug.Print Err & vbCr & vbLf & Error ' gives 0 The default Err property is the error number, so in this situation Err is taken as Err.number The exact working of Error is unclear, but if an error occurs it seems to do a few things, and one of them is that it returns the error description Let Rslt = 1 / 0 ' This causes me to go to ErrHndler The Resume Lbl brings me back to just after the label, Lbl: Lbl: Debug.Print Err & vbCr & vbLf & Error ' gives 0 The Resume Lbl cleared the Err registers Exit Sub ErrHndler: ' Start of what is commonly called an "error handling code section" Debug.Print Err & vbCr & vbLf & Error ' gives 11 Division durch Null The Err register is always filled in all situatiuons when an error occurs, regardless of what error handler is or isn't in place. Resume Lbl ' This clears the exception, clears the Err registers, and instructs VBA to go to the code line just after the label Lbl: End Sub

If we use On Error GoTo [LABEL] and then use Resume ( Resume; Resume Next; Resume [label] ) then we appear to be having something done very similar, or possibly exactly the same as On Error GoTo -1 , since the exception state is cleared and the Err object is cleared.
To demonstrate this we can do the last three routines again, and simply add another error handler , for example On Error Resume Next , after the return point, and follow this by an error. If the error is handled, that is to say we get no default VBA error message, then we know that the exception had been cleared previously. If it had not been cleared then the new error handler, On Error Resume Next , would have been ignored and we would have seen the default VBA error handler warning pop up message.

_..... continued in next post
11-30-2020, 02:47 PM
DocAElstein

Some extra notes for a few Posts
http://www.eileenslounge.com/viewtop...278892#p278892
https://www.myonlinetraininghub.com/...andling-in-vba
https://excelfox.com/forum/showthrea...GoRoT-N0Nula-1
https://excelfox.com/forum/showthrea...0559#post10559

_.... from last post

If we use On Error GoTo [LABEL] and then use Resume ( Resume; Resume Next; Resume [label] ) then we appear to be having something done very similar, or possibly exactly the same as On Error GoTo -1 , since the exception state is cleared and the Err object is cleared.
To demonstrate this we can do the last three routines again, and simply add another error handler , for example On Error Resume Next , after the return point, and follow this by an error. If the error is handled, that is to say we get no default VBA error message, then we know that the exception had been cleared previously. If it had not been cleared then the new error handler, On Error Resume Next , would have been ignored and we would have seen the default VBA error handler warning pop up message.

Code:

' If we use On Error GoTo [LABEL] and then use Resume ( Resume; Resume Next; Resume [label] ) then we appear to be having something done very similar, or possibly exactly the same as On Error GoTo -1 , since the exception state is cleared and the Err object is cleared. Sub Resume_ClearsErr_() ' _ Resume, ( Resume ) Dim Rslt As Double, Demonostrator As Long On Error GoTo ErrHndler Debug.Print Err & vbCr & vbLf & Error Let Rslt = 1 / Demonostrator Debug.Print Err & vbCr & vbLf & Error On Error Resume Next ' This would be ignored if I was in exception state. Let Rslt = 1 / 0 ' This does not give us an error , so the last code line worked, indicating that we were not in exception state On Error GoTo 0 ' I do not need to do this since I am Exiting Sub in next code line. But it is good practice to get in the habit of doing this to return to normnal default VBA error handling if i know i am finished using the Error handler which I enabled Exit Sub ErrHndler: Debug.Print Err & vbCr & vbLf & Error Let Demonostrator = 1 Resume End Sub Sub Resume_Next_ClearsErr_() ' 'Resume, ( Resume Next ) Dim Rslt As Double On Error GoTo ErrHndler Debug.Print Err & vbCr & vbLf & Error Let Rslt = 1 / 0 Debug.Print Err & vbCr & vbLf & Error On Error Resume Next ' This would be ignored if I was in exception state. Let Rslt = 1 / 0 ' This does not give us an error , so the last code line worked, indicating that we were not in exception state On Error GoTo 0 ' I do not need to do this since I am Exiting Sub in next code line. But it is good practice to get in the habit of doing this to return to normnal default VBA error handling if i know i am finished using the Error handler which I enabled Exit Sub ErrHndler: Debug.Print Err & vbCr & vbLf & Error Resume Next End Sub Sub Resume_LABEL_ClearsErr_() ' 'Resume, ( Resume [label] ) Dim Rslt As Double On Error GoTo ErrHndler Debug.Print Err & vbCr & vbLf & Error Let Rslt = 1 / 0 Lbl: Debug.Print Err & vbCr & vbLf & Error On Error Resume Next ' This would be ignored if I was in exception state. Let Rslt = 1 / 0 ' This does not give us an error , so the last code line worked, indicating that we were not in exception state On Error GoTo 0 ' I do not need to do this since I am Exiting Sub in next code line. But it is good practice to get in the habit of doing this to return to normnal default VBA error handling if i know i am finished using the Error handler which I enabled Exit Sub ErrHndler: Debug.Print Err & vbCr & vbLf & Error Resume Lbl End Sub
11-30-2020, 02:47 PM
DocAElstein

Some extra notes for a few Posts
http://www.eileenslounge.com/viewtop...278892#p278892
https://www.myonlinetraininghub.com/...andling-in-vba
https://excelfox.com/forum/showthrea...GoRoT-N0Nula-1
https://excelfox.com/forum/showthrea...0559#post10559

As far as I can tell , the Err object is always filled with information about the last error that occurred, and it seems to me that its sole purpose is to have information about the last error. It can be cleared with Err.Clear , and , is also cleared as a secondary function of other things, including On Error GoTo -1
( In fact it appears the Err is actually a function or an object, possibly working like something similar to Range(xx) which can be regarded as an object or property or function depending on how you use it. We can probably say that Err is a function which returns the Err object. I think that possibly Error is also a similar function. I am not sure exactly what it does, but one thing it does is return the same as Err.Decription, so it can be used in place of Err.Description )

The main purpose of On Error GoTo -1 is to take Excel out of the exception state. The exception state is generally caused by an error occurring. An exception to this being , possibly, of when On Error Resume Next is used: But this is not clear to anyone, as far as I can tell: Its not clear whether
either:
On Error Resume Next prevents the excepting state occurring
or
On Error Resume Next cause the exception state to be cleared immediately after an error occurs.

If On Error Resume Next is used and an error occurs, then something similar to doing On Error GoTo -1 happens. But it is not exactly the same, since the Err object is not cleared, as it is by On Error GoTo -1

Code:

Sub OnErrorResumeNext() ' If On Error Resume Next is used and an error occurs, then something similar to doing On Error GoTo -1 happens. But it is not exactly the same, since the Err object is not cleared, as it is by On Error GoTo -1 Dim Rslt As Double On Error Resume Next Let Rslt = 1 / 0 ' It is generally thought that we are not in the exception state, but the next line does tell us what error occured, so the On Error Resume Next has not simply done a On Error GoTo -1 , since On Error GoTo -1 would have resulted inj the Err object being cleared which would mean that the next code line retuned us 0 Debug.Print Err & vbCr & vbLf & Error ' gives 11 Division durch Null The Err register is always filled in all situatiuons when an error occurs, regardless of what error handler is or isn't in place. On Error GoTo Bed Let Rslt = 1 / 0 ' We do not get a VBA default error here. We go to Bed: So the error handler worked indicating that we were not in the exception state On Error GoTo 0 ' I do not need this or the next code line, but its good to get into the habit of turning off any used error handler and having an Exit Sub above a typiucal endind error handling code section Exit Sub Bed: Debug.Print Err & vbCr & vbLf & Error ' gives 11 Division durch Null The Err register is always filled in all situatiuons when an error occurs, regardless of what error handler is or isn't in place. End Sub
11-30-2020, 02:47 PM
DocAElstein

Some extra notes for a few Posts
http://www.eileenslounge.com/viewtop...278892#p278892
https://www.myonlinetraininghub.com/...andling-in-vba
https://excelfox.com/forum/showthrea...GoRoT-N0Nula-1
https://excelfox.com/forum/showthrea...0559#post10559

The Exceptions State

The concept of the exception state is rarely understood.
The most noticeable effect of the error state is that further errors are dealt with by the default VBA error handling. It’s not relevant whether we are in the so called “error handling block” or not.

This frequently catches people out, in particular in a loop situation when error handling only works once, when they had been expecting it to trap all errors occurring: In the exception state, any enabled error handler won’t work again, and any attempt to use / enable another will be ignored.
( In this exception state, the On Error statement , On Error GoTo 0 , would do its main job of disabling any enabled error handler, but it won’t have any effect directly on anything, because it doesn’t clear the exception state. Its effect would only be noticed if the exception was cleared).

See here:
http://www.eileenslounge.com/viewtop...278892#p278892
http://www.eileenslounge.com/viewtop...278909#p278909
http://www.eileenslounge.com/viewtop...278922#p278922
11-30-2020, 02:47 PM
DocAElstein

Some extra notes for a few Posts
http://www.eileenslounge.com/viewtop...278892#p278892
https://www.myonlinetraininghub.com/...andling-in-vba
https://excelfox.com/forum/showthrea...GoRoT-N0Nula-1
https://excelfox.com/forum/showthrea...0559#post10559

hhfhhsfhhfaskh
12-08-2020, 05:21 PM
DocAElstein

macro or this Post:
https://excelfox.com/forum/showthrea...ll=1#post15165

Code:

Sub ConcatWithStyles() ' https://www.mrexcel.com/board/threads/the-hardest-question-in-excel-history-a-very-smart-vba-macro-to-combine-cell-with-their-styles.808781/#post-3954687 Rem 0a save the formulas, and replace with values Dim arrFormulas() As Variant Let arrFormulas() = Range("A1:F1").Formula Let Range("A1:F1").Value = Range("A1:F1").Value Dim X As Long, Cell As Range, Text As String, Position As Long Range("A3").Value = Space(Evaluate("SUM(LEN(A1:F1))+COLUMNS(A1:F1)-1")) Position = 1 ' Application.ScreenUpdating = False For Each Cell In Range("A1:F1") With Range("A3") .Characters(Position, Len(Cell.Value)).Text = Cell.Characters(1, Len(Cell.Value)).Text For X = 1 To Len(Cell.Value) With .Characters(Position + X - 1, 1).Font .Name = Cell.Characters(X, 1).Font.Name .Size = Cell.Characters(X, 1).Font.Size .Bold = Cell.Characters(X, 1).Font.Bold .Italic = Cell.Characters(X, 1).Font.Italic .Underline = Cell.Characters(X, 1).Font.Underline .Color = Cell.Characters(X, 1).Font.Color .Strikethrough = Cell.Characters(X, 1).Font.Strikethrough .Subscript = Cell.Characters(X, 1).Font.Subscript .Superscript = Cell.Characters(X, 1).Font.Superscript .TintAndShade = Cell.Characters(X, 1).Font.TintAndShade .FontStyle = Cell.Characters(X, 1).Font.FontStyle End With Next End With Position = Position + Len(Cell.Value) + 1 Next Application.ScreenUpdating = True Rem 0b Put the formulas back Let Range("A1:F1").Formula = arrFormulas() End Sub
12-10-2020, 04:03 PM
DocAElstein

In support of these Thread answers:
' ' https://www.mrexcel.com/board/thread.../#post-3954687 https://excelfox.com/forum/showthrea...ll=1#post15170

It was seen ( https://excelfox.com/forum/showthrea...ll=1#post15168
https://excelfox.com/forum/showthrea...ll=1#post15167 ) when solving the formula in cell issue, that the cells containing the formula can only have a single style for all characters in the cell. So it’s not necessary to loop through the characters in each cell when setting the style in the concatenated string from those cells.

Code:

' ' https://www.mrexcel.com/board/threads/the-hardest-question-in-excel-history-a-very-smart-vba-macro-to-combine-cell-with-their-styles.808781/#post-3954687 https://excelfox.com/forum/showthread.php/2679-Concatenate-with-style?p=15170&viewfull=1#post15170 Sub ConcatWithStyles3() Dim RngSel As Range: Set RngSel = Selection: Set RngSel = Range("A1:F1") Rem 0a save any formulas, and replace with values Dim arrFormulas() As Variant Let arrFormulas() = RngSel.Formula ' Assuming wew select more than one cell, we will always be presented by .Value a 2 dimensional array, ( even if it is a single row or single column ) This codel line will error if we are using a selection of one cell, since in that case .Value only returns a single value which VBA syntax does not allow to be assigned to a dynmic array Dim RwCnt As Long, ClmCnt As Long ' For RwCnt = 1 To RngSel.Rows.Count ' At each row we...._ ' For ClmCnt = 1 To RngSel.Columns.Count ' If Left(arrFormulas(RwCnt, ClmCnt), 1) = "=" Then ' case a formula in cell ' Let RngSel.Item(RwCnt, ClmCnt).Value = RngSel.Item(RwCnt, ClmCnt).Value ' replace the formula with its value ' Else ' End If ' Next ClmCnt ' Next RwCnt Dim RwsCnt As Long, ClmsCnt As Long, Itm As Long, ItmCnt As Long Let ItmCnt = RngSel.Cells.Count Let RwsCnt = RngSel.Rows.Count: Let ClmsCnt = RngSel.Columns.Count For Itm = 1 To ItmCnt If Left(arrFormulas(Int((Itm - 1) / ClmsCnt) + 1, Int((Itm - 1) / RwsCnt) + 1), 1) = "=" Then ' case a formula in cell Let RngSel.Item(Itm).Value = RngSel.Item(Itm).Value ' replace the formula with its value Else End If Next Itm Dim ExChr As Long, ACel As Range, TeExt As String, Position As Long ' Let Range("A3").Value = Space(Evaluate("SUM(LEN(A1:F1))+COLUMNS(A1:F1)-1")) ' This makes a teExt of spaces. The number of spaces is the sum of all the teExt in the cells + one less than the number of cells. This gives us enough characters for all the teExt and a space betweeen them Let Range("A3").Value = Space(Evaluate("=SUM(LEN(" & RngSel.Address & "))+COLUMNS(" & RngSel.Address & ")-1")) Let Position = 1 ' Let Application.ScreenUpdating = False ' adding this code line may speed the macro up a bit Let Itm = 0 For Each ACel In RngSel Let Itm = Itm + 1 With Range("A3") ' The range ( cell ) used for final output of concatenated cell text with styles 'here in next code line we put the characters in... .Characters(Position, Len(ACel.Value)).Text = ACel.Value ' ACel.Characters(1, Len(ACel.Value)).Text ' ACel.Value This puts the charascters If Left(arrFormulas(Int((Itm - 1) / ClmsCnt) + 1, Int((Itm - 1) / RwsCnt) + 1), 1) = "=" Then ' We only need to consider the cell style, since individual styles on characters are not possible in a cell with a formula in it ' ....it's not necessary to loop through the characters in each cell when setting the style in the concatenated string from those cells containing formulas With .Characters(Position, Len(ACel.Value)).Font ' all the characters from the current cell in the final concatenated string .Name = ACel.Font.Name .Size = ACel.Font.Size .Bold = ACel.Font.Bold .Italic = ACel.Font.Italic .Underline = ACel.Font.Underline .Color = ACel.Font.Color .Strikethrough = ACel.Font.Strikethrough .Subscript = ACel.Font.Subscript .Superscript = ACel.Font.Superscript .TintAndShade = ACel.Font.TintAndShade .FontStyle = ACel.Font.FontStyle End With ' Else ' we need to consider all characters in the cell For ExChr = 1 To Len(ACel.Value) ' We are looping for all the tExt Chraracters in the current cell text ' here in the next With End With section the next character in the final concatenated string is given the styles that it had in the cell it came from With .Characters(Position + ExChr - 1, 1).Font ' A single character in the final concatenated string .Name = ACel.Characters(ExChr, 1).Font.Name .Size = ACel.Characters(ExChr, 1).Font.Size .Bold = ACel.Characters(ExChr, 1).Font.Bold .Italic = ACel.Characters(ExChr, 1).Font.Italic .Underline = ACel.Characters(ExChr, 1).Font.Underline .Color = ACel.Characters(ExChr, 1).Font.Color .Strikethrough = ACel.Characters(ExChr, 1).Font.Strikethrough .Subscript = ACel.Characters(ExChr, 1).Font.Subscript .Superscript = ACel.Characters(ExChr, 1).Font.Superscript .TintAndShade = ACel.Characters(ExChr, 1).Font.TintAndShade .FontStyle = ACel.Characters(ExChr, 1).Font.FontStyle End With ' Next ExChr End If End With Position = Position + Len(ACel.Value) + 1 ' This takes us to posiion at the end of the current cell text +1 ( +1 Next ACel Application.ScreenUpdating = True Rem 0b Put the formulas back For RwCnt = 1 To RngSel.Rows.Count ' At each row we...._ For ClmCnt = 1 To RngSel.Columns.Count If Left(arrFormulas(RwCnt, ClmCnt), 1) = "=" Then ' ' case a formula was in cell Let RngSel.Item(RwCnt, ClmCnt).Formula = arrFormulas(RwCnt, ClmCnt) ' we put the formula back Else ' we didnt have a formula , so we do nothing to the cell - if we did then we would likely get just one style in the cell - a text with more than one style would revert to one single style throughout End If Next ClmCnt Next RwCnt End Sub
01-15-2021, 10:53 PM
DocAElstein

Coding for this Thread
http://www.eileenslounge.com/viewtopic.php?f=30&t=35980
and this post
https://eileenslounge.com/viewtopic....279798#p279798

Full version:

Code:

Sub Test() ' http://www.eileenslounge.com/viewtopic.php?f=30&t=35980 Dim Indx As Long ' the index of the element to be removed - for this example it can be chosen to be 0 or 1 or 2 or 3 or 4 Let Indx = 4 Dim arr1D() As Variant Let arr1D() = Array(1, 2, 3, 4, 5) Dim Joint As String Let Joint = Join(arr1D(), "|"): Debug.Print Joint ' 1|2|3|4|5 ' - make sure you use a seperator that does not appear in any array element Let Joint = "|" & Joint & "|": Debug.Print Joint ' |1|2|3|4|5| ' - needed so that I can get at the last and first element also Dim CrackedJoint As String ' For cracked Joint ' I can use Application.WorksheetFunction.Substitute to pick out specific seperators , so I will replace the one before and after with some word like "Crack" Let CrackedJoint = Application.WorksheetFunction.Substitute(Joint, "|", "Crack2", Indx + 2): Debug.Print CrackedJoint ' |1|2|3|4|5Crack2 ' ' https://excelfox.com/forum/showthread.php/2230-Built-in-VBA-methods-and-functions-to-alter-the-contents-of-existing-character-strings Let CrackedJoint = Application.WorksheetFunction.Substitute(CrackedJoint, "|", "Crack1", Indx + 1): Debug.Print CrackedJoint ' |1|2|3|4Crack15Crack2 Dim Crack1 As Long, Crack2 As Long ' The positions of the cracks Let Crack1 = InStr(1, CrackedJoint, "Crack1", vbBinaryCompare): Debug.Print Crack1 ' 9 Let Crack2 = InStr(1, CrackedJoint, "Crack2", vbBinaryCompare): Debug.Print Crack2 ' 16 Dim LeftBit As String, RightBit As String Let LeftBit = Left$(CrackedJoint, Crack1 - 1): Debug.Print LeftBit ' |1|2|3|4 Let RightBit = "|" & Mid$(CrackedJoint, Crack2 + 6): Debug.Print RightBit ' | Dim JointedJoint As String Let JointedJoint = LeftBit & RightBit: Debug.Print JointedJoint ' |1|2|3|4| Let JointedJoint = Mid(JointedJoint, 2, Len(JointedJoint) - 2): Debug.Print JointedJoint ' 1|2|3|4 Dim arr1DOut() As String Let arr1DOut() = Split(JointedJoint, "|", -1, vbBinaryCompare) ' The above array is of element types of String , so we can't assign that to out original Variant type array. We can convert with Let arr1D() = Application.Index(arr1DOut(), Evaluate("={1,1,1,1}"), Evaluate("={1,2,3,4}")) ' https://www.excelforum.com/tips-and-tutorials/758402-vba-working-with-areas-within-2d-arrays.html#post5408376 Let arr1D() = Application.Index(arr1DOut(), Evaluate("=Column(A:D)/Column(A:D)"), Evaluate("=Column(A:D)")) ' https://www.excelforum.com/excel-programming-vba-macros/1328703-copy-1-dim-array-to-and-2-dim-array.html#post5410028 Let arr1D() = Application.Index(arr1DOut(), Evaluate("=Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")/Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")"), Evaluate("=Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")")) ' ' or Let arr1D() = Application.Index(arr1DOut(), 1, 0) ' End Sub

“One liner ( almost ) “ versions

Code:

Sub Test2() Dim Indx As Long Let Indx = 4 Dim arr1D() As Variant: Let arr1D() = Array(1, 2, 3, 4, 5) Let arr1D() = Application.Index(Split(Mid(Left$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "@") - 1) & "|" & Mid$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "#") + 1), 2, Len(Left$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), _ InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "@") - 1) & "|" & Mid$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "#") + 1)) - 2), "|"), Evaluate("=Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")/Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")"), Evaluate("=Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")")) ' End Sub Sub Test3() Dim Indx As Long Let Indx = 1 Dim arr1D() As Variant: Let arr1D() = Array(1, 2, 3, 4, 5) Let arr1D() = Application.Index(Split(Mid(Left$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "@") - 1) & "|" & Mid$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "#") + 1), 2, Len(Left$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), _ InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "@") - 1) & "|" & Mid$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "#") + 1)) - 2), "|"), Evaluate("=Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")/Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")"), Evaluate("=Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")")) ' End Sub

Function version

Code:

Sub testFunction() Dim arr1D() As Variant: Let arr1D() = Array(1, "2", 3, 4, 5) Let arr1D() = DeleteItem(arr1D(), 1) End Sub Function DeleteItem(ByVal Var As Variant, Indx As Long) As Variant Let DeleteItem = Application.Index(Split(Mid(Left$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(Var, "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(Var, "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "@") - 1) & "|" & Mid$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(Var, "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(Var, "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "#") + 1), 2, Len(Left$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(Var, "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), _ InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(Var, "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "@") - 1) & "|" & Mid$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(Var, "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(Var, "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "#") + 1)) - 2), "|"), Evaluate("=Column(A:" & Split(Cells(1, UBound(Var)).Address, "$", -1, vbBinaryCompare)(1) & ")/Column(A:" & Split(Cells(1, UBound(Var)).Address, "$", -1, vbBinaryCompare)(1) & ")"), Evaluate("=Column(A:" & Split(Cells(1, UBound(Var)).Address, "$", -1, vbBinaryCompare)(1) & ")")) ' End Function
01-15-2021, 10:58 PM
DocAElstein

Coding for this Thread
http://www.eileenslounge.com/viewtopic.php?f=30&t=35980
and this post
https://eileenslounge.com/viewtopic....de06b5#p279861

Code:

Sub DeleteItemByIndexIn1DArraySHG1() ' http://www.eileenslounge.com/viewtopic.php?f=30&t=35980&p=279809#p279809 https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=15218&viewfull=1#post15218 Dim Indx As Long ' Let Indx = 1 ' 1 is for deleting the first element Dim arr1D() As Variant Let arr1D() = Array(1, 2, 3, 4, 5) Dim Joint As String Let Joint = Join(arr1D(), ","): Debug.Print Joint ' 1,2,3,4,5 ' - make sure you use a seperator that does not appear in any array element Dim Pos1 As Long, Pos2 As Long Let Pos1 = Evaluate("=Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))") Debug.Print Pos1 ' 1 Let Pos2 = Evaluate("=Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))") Debug.Print Pos2 ' 3 Dim LeftBit As String, RightBit As String Let LeftBit = Left$("," & Joint, Pos1 - 1): Debug.Print LeftBit ' nothing there ' Let LeftBit = Evaluate("=Left(""," & Joint & """, " & Pos1 - 1 & ")"): Debug.Print LeftBit ' nothing there Let RightBit = "," & Mid$("," & Joint & ",", Pos2 + 1): Debug.Print RightBit ' ,2,3,4,5, ' The MID spreadsheet function is less helpful since it must have the third argument ( in VBA MID the third length argument is optional Let RightBit = "," & Right$("," & Joint & ",", Len(Joint) - (Pos2 - 2)): Debug.Print RightBit ' ,2,3,4,5, ' we don't want to take off the , and Joint is one less than Joint & "," so we take off in total 2 less Let RightBit = Evaluate("="",""&Right(""," & Joint & ","", Len(""" & Joint & """) - (" & Pos2 - 2 & "))") Debug.Print RightBit ' ,2,3,4,5, ' Rem Joining the two and trimming odff the leading and trailing seperators Dim JointedJoint As String 'Let JointedJoint = LeftBit & RightBit: Debug.Print JointedJoint ' ,2,3,4,5, 'Let JointedJoint = Evaluate("=""" & LeftBit & RightBit & """"): Debug.Print JointedJoint ' ,2,3,4,5, Let JointedJoint = Evaluate("=" & """" & LeftBit & RightBit & """"): Debug.Print JointedJoint ' ,2,3,4,5, Let JointedJoint = Evaluate("=" & """" & LeftBit & ",""&Right(""," & Joint & ","", Len(""" & Joint & """) - (" & Pos2 - 2 & "))") Debug.Print JointedJoint ' ,2,3,4,5, Let JointedJoint = Evaluate("=Left(""," & Joint & """, " & Pos1 - 1 & ")&"",""&Right(""," & Joint & ","", Len(""" & Joint & """) - (" & Pos2 - 2 & "))") Debug.Print JointedJoint ' ,2,3,4,5, Let JointedJoint = Evaluate("=Left(""," & Joint & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Joint & ","", Len(""" & Joint & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))") Debug.Print JointedJoint ' ,2,3,4,5, 'Let JointedJoint = Mid(JointedJoint, 2, Len(JointedJoint) - 2): Debug.Print JointedJoint ' 2,3,4,5 'Debug.Print JointedJoint ' 2,3,4,5 'Let JointedJoint = Evaluate("=Mid(Left(""," & Joint & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Joint & ","", Len(""" & Joint & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2)),2,Len(Left(""," & Joint & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Joint & ","", Len(""" & Joint & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))))") ' Evaluate string has 355 characters so it wont work 'Debug.Print JointedJoint Let JointedJoint = Mid(Evaluate("=Left(""," & Joint & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Joint & ","", Len(""" & Joint & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))"), 2, Len(Evaluate("=Left(""," & Joint & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Joint & ","", Len(""" & Joint & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))")) - 2) Debug.Print JointedJoint ' 2,3,4,5 ' replace Joint with Join(arr1D(), ",") Let JointedJoint = Mid(Evaluate("=Left(""," & Join(arr1D(), ",") & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Join(arr1D(), ",") & ","", Len(""" & Join(arr1D(), ",") & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))"), 2, Len(Evaluate("=Left(""," & Join(arr1D(), ",") & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Join(arr1D(), ",") & ","", Len(""" & Join(arr1D(), ",") & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))")) - 2) Debug.Print JointedJoint ' 2,3,4,5 ' Get the string array back Dim arr1DOut() As String Let arr1DOut() = Split(JointedJoint, ",", -1, vbBinaryCompare): Let arr1DOut() = Split(JointedJoint, ",") Let arr1DOut() = Split(Mid(Evaluate("=Left(""," & Join(arr1D(), ",") & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Join(arr1D(), ",") & ","", Len(""" & Join(arr1D(), ",") & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))"), 2, Len(Evaluate("=Left(""," & Join(arr1D(), ",") & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Join(arr1D(), ",") & ","", Len(""" & Join(arr1D(), ",") & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))")) - 2), ",") ' The spilt has returned string Elements, so we can't directly assign to the original array ' Let arr1D() = Application.Index(arr1DOut(), Evaluate("={1,1,1,1}"), Evaluate("={1,2,3,4}")) ' https://www.excelforum.com/tips-and-tutorials/758402-vba-working-with-areas-within-2d-arrays.html#post5408376 ' Let arr1D() = Application.Index(arr1DOut(), Evaluate("=Column(A:D)/Column(A:D)"), Evaluate("=Column(A:D)")) ' https://www.excelforum.com/excel-programming-vba-macros/1328703-copy-1-dim-array-to-and-2-dim-array.html#post5410028 ' Let arr1D() = Application.Index(arr1DOut(), Evaluate("=Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")/Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")"), Evaluate("=Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")")) ' ' or ' Let arr1D() = Application.Index(arr1DOut(), 1, 0) ' https://excelfox.com/forum/showthread.php/1111-VBA-Trick-of-the-Week-Slicing-an-Array-Without-Loop-%c3%a2%e2%82%ac%e2%80%9c-Application-Index Let arr1D() = Application.Index(Split(Mid(Evaluate("=Left(""," & Join(arr1D(), ",") & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Join(arr1D(), ",") & ","", Len(""" & Join(arr1D(), ",") & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))"), 2, Len(Evaluate("=Left(""," & Join(arr1D(), ",") & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Join(arr1D(), ",") & ","", Len(""" & Join(arr1D(), ",") & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))")) - 2), ","), 1, 0) ' Full workings: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=15218&viewfull=1#post15218 End Sub

Or ....

Code:

Sub DeleteItemByIndexIn1DArraySHG2() ' http://www.eileenslounge.com/viewtopic.php?f=30&t=35980&p=279809#p279809 https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=15218&viewfull=1#post15218 Dim Indx As Long ' Let Indx = 1 ' 1 is for deleting the first element Dim arr1D() As Variant: Let arr1D() = Array(1, 2, 3, 4, 5) Let arr1D() = Application.Index(Split(Mid(Evaluate("=Left(""," & Join(arr1D(), ",") & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Join(arr1D(), ",") & ","", Len(""" & Join(arr1D(), ",") & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))"), 2, Len(Evaluate("=Left(""," & Join(arr1D(), ",") & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Join(arr1D(), ",") & ","", Len(""" & Join(arr1D(), ",") & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))")) - 2), ","), 1, 0) ' Full workings: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=15218&viewfull=1#post15218 End Sub

Some explanations in next post
01-16-2021, 02:24 PM
DocAElstein

( In this example, Indx, is the Index number of the element that we want to remove starting from 1 – For the first element Indx must be given as 1

In Words , this is how the main code line works…( taking the example of wanting to remove the first element
My 1 D array , for example , {1,2,3,4,5} , is turned into a single text string, “1,2,3,4,5”. ( The separating thing, a comma in this case, is arbitrary. You should choose some character that is not likely to appear in any of your data.)
The next thing to do is add additional leading and trailing separating things ( commas in this example ) , so in the example it would then look like “,1,2,3,4,5,”

Now we use this sort of bit a lot.. Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx +1 & "))
Substitute is used to change the comma before the element you want to some other arbitrary separating thing.
So lets say we used a | and are wanting the first element ( Indx=1 ) removed. We then would have like
“|1,2,3,4,5,”
We then do a Find to get the position of that |
In other words,
The Substitute gives us this "|1,2,3,4,5,"
The Find looks for the | and gives us 1
Substitute is used again to change the comma after the element you want to some other arbitrary separating thing.
So lets say we used a | again. ( we are still wanting the first element) We then would have like
“,1|2,3,4,5,”
We then do a Find to get the position of that |
In other words,
The Substitute gives us this ",1|2,3,4,5,"
The Find looks for that | and gives us 3
Here is the last bit in close to the final code line:

Code:

Mid(Evaluate("=Left(""," & Join(arr1D(), ",") & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Join(arr1D(), ",") & ","", Len(""" & Join(arr1D(), ",") & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))"), 2, Len(Evaluate("=Left(""," & Join(arr1D(), ",") & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Join(arr1D(), ",") & ","", Len(""" & Join(arr1D(), ",") & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))")) - 2)

So we now know where the start and the end is of the element that we want to remove are
We can use this information to determine the string before, and to determine the string after, the element that we want to remove.
So we put those two strings together and that gives us the original string without the element that we want to remove.
Finally we Split that text back into an array

( Once again we will have all string elements out, regardless of what element types we have in our original array )
01-16-2021, 02:25 PM
DocAElstein

post for later use..
http://i.imgur.com/dol9tfQ.jpg
http://i.imgur.com/Ucpj9pZ.jpg
http://i.imgur.com/mtLzChH.jpg
http://i.imgur.com/N2PbR0C.jpg
http://i.imgur.com/Nzfnk90.jpg
http://i.imgur.com/rnYpqNh.jpg
http://i.imgur.com/RODuXQl.jpg
http://i.imgur.com/zpWglC9.jpg

Hello
I tried it , second one, http://i.imgur.com/wL6hN1c.jpg
It did not work

http://i.imgur.com/Z7bl5cc.jpg
http://i.imgur.com/NG2ICxa.jpg
http://i.imgur.com/EpDQOXB.jpg

Alan
01-16-2021, 02:25 PM
DocAElstein

post for later use-
01-16-2021, 02:25 PM
DocAElstein

post for later use
01-16-2021, 02:25 PM
DocAElstein

post for later use

_Row\^Col	A	B	C	D	E
1	Sales Man	Territory	Dimension	Sales Amt	Cost
2	John	New York	Tissue	1,000.00	200.00
3	Alfred	Washington	Soda	2,100.00	700.00
4	John	New York	Soda	2,050.00	1,500.00
5	Alfred	New York	Tissue	2,000.00	500.00
6	Leo	Washington	Soda	200.00	100.00
7	Leo	New York	Tissue	3,500.00	1,500.00
8	Maxwell	Washington	Towel	1,000.00	800.00

_Row\^Col	D	E
2	=IF(ISERROR(INDEX(Export1!D$1:D$9,MATCH($A2 & "¬" & $B2 & "¬" & $C2,Export1!$A$1:$A$9 & "¬" & Export1!$B$1:$B$9 & "¬" & Export1!$C$1:$C$9,0))),"",INDEX(Export1!D$1:D$9,MATCH($A2 & "¬" & $B2 & "¬" & $C2,Export1!$A$1:$A$9 & "¬" & Export1!$B$1:$B$9 & "¬" & Export1!$C$1:$C$9,0)))	=IF(ISERROR(INDEX(Export1!E$1:E$9,MATCH($A2 & "¬" & $B2 & "¬" & $C2,Export1!$A$1:$A$9 & "¬" & Export1!$B$1:$B$9 & "¬" & Export1!$C$1:$C$9,0))),"",INDEX(Export1!E$1:E$9,MATCH($A2 & "¬" & $B2 & "¬" & $C2,Export1!$A$1:$A$9 & "¬" & Export1!$B$1:$B$9 & "¬" & Export1!$C$1:$C$9,0)))

_Row\^Col	D	E
2	=IFERROR(INDEX(Export1!D$1:D$9,MATCH($A2 & "¬" & $B2 & "¬" & $C2,Export1!$A$1:$A$9 & "¬" & Export1!$B$1:$B$9 & "¬" & Export1!$C$1:$C$9,0)),"")	=IFERROR(INDEX(Export1!E$1:E$9,MATCH($A2 & "¬" & $B2 & "¬" & $C2,Export1!$A$1:$A$9 & "¬" & Export1!$B$1:$B$9 & "¬" & Export1!$C$1:$C$9,0)),"")

_Row\^Col	D	E
2	=IF(ISERROR(INDEX(Export1!$D$2:$D$8,MATCH(1,(ResIndex!A2=Export1!$A$2:$A$8)(ResIndex!B2=Export1!$B$2:$B$8)(ResIndex!C2=Export1!$C$2:$C$8),0),1)),"",INDEX(Export1!$D$2:$D$8,MATCH(1,(ResIndex!A2=Export1!$A$2:$A$8)(ResIndex!B2=Export1!$B$2:$B$8)(ResIndex!C2=Export1!$C$2:$C$8),0),1))	=IF(ISERROR(INDEX(Export1!$E$2:$E$8,MATCH(1,(ResIndex!A2=Export1!$A$2:$A$8)(ResIndex!B2=Export1!$B$2:$B$8)(ResIndex!C2=Export1!$C$2:$C$8),0),1)),"",INDEX(Export1!$E$2:$E$8,MATCH(1,(ResIndex!A2=Export1!$A$2:$A$8)(ResIndex!B2=Export1!$B$2:$B$8)(ResIndex!C2=Export1!$C$2:$C$8),0),1))

_Row\^Col	D	E
2	=IFERROR(INDEX(Export1!$D$2:$D$8,MATCH(1,(ResIndex2!A2=Export1!$A$2:$A$8)(ResIndex2!B2=Export1!$B$2:$B$8)(ResIndex2!C2=Export1!$C$2:$C$8),0),1),"")	=IFERROR(INDEX(Export1!$E$2:$E$8,MATCH(1,(ResIndex2!A2=Export1!$A$2:$A$8)(ResIndex2!B2=Export1!$B$2:$B$8)(ResIndex2!C2=Export1!$C$2:$C$8),0),1),"")

MID( SUBSTITUTE(Text,Delim,REPT(" ",LEN(Text))) , element*LEN(Text)-(LEN(Text)-1) , LEN(Text) )

Test...

MID( SUBSTITUTE(Text,Delim,REPT(" ",LEN(Text))) , (element*LEN(Text)) - (LEN(Text)-1) , LEN(Text) )
MID( SUBSTITUTE(Text,Delim,REPT(" ",LEN(Text))) , (element*LEN(Text)) - ( LEN(Text) ) , LEN(Text) )

_Row\^Col
A

B

C

1
What is pseudo is in the Cell to the left ( column B )

2
Example get the first thing, 1 from the Text string "1,3,5"
1,3,5
my original test text

3
Length
5
the length in characters of my original test text

4
( Rept " " ) x Length 5 spaces like "12345"

5
Substitute in the original string ( B2 ) 5 spaces for each comma seperator
1_____3_____5
like "1123453123455" is 13 characters

6
I apply to B5 the MID function starting at (1x5)-(5-1)=1 and for a length of 5
1____
like "11234"

7
I apply to B5 the MID function starting at (1x5)-(5)=0 and for a length of 5
#VALUE!
Excel doesn't forgive me for trying to start at 0 !!!!

8

9
Example get the second thing, 3 from the Text string "1,3,5"
1,3,5
my original test text

10
Length
5
the length in characters of my original test text

11
( Rept " " ) x Length 5 spaces like "12345"

12
Substitute in the original string ( B9 ) 5 spaces for each comma seperator
1_____3_____5
like "1123453123455" is 13 characters

13
I apply to B12 the MID function starting at (2x5)-(5-1)=6 and for a length of 5
_3___
like "13123"

14
I apply to B12 the MID function starting at (2x5)-(5)=5 and for a length of 5
__3__
like "12312"

15

16
Example get the third thing, 5 from the Text string "1,3,5"
1,3,5
my original test text

17
Length
5
the length in characters of my original test text

18
( Rept " " ) x Length 5 spaces like "12345"

19
Substitute in the original string ( B16 ) 5 spaces for each comma seperator
1_____3_____5
like "1123453123455" is 13 characters

20
I apply to B19 the MID function starting at (3x5)-(5-1)=11 and for a length of 5
__5
like "125" Note: I try to do length 5, but Excel forgives me and gives the 3 it has available

21
I apply to B19 the MID function starting at (1x5)-(5)=0 and for a length of 5
___5
like "1235" Note: I try to do length 5, but Excel forgives me and gives the 4 it has available

_Row\^Col
B

1

2

1,3,5

3

=LEN(B2)

4

=REPT(" ",B3)

5

=SUBSTITUTE(B2,",",B4)

6

=MID(B5,(1*B3)-(B3-1),B3)

7

=MID(B5,(1*B3)-(B3),B3)

8

9

1,3,5

10

=LEN(B9)

11

=REPT(" ",B10)

12

=SUBSTITUTE(B9,",",B11)

13

=MID(B12,(2*B10)-(B10-1),B10)

14

=MID(B12,(2*B10)-(B10),B10)

15

16

1,3,5

17

=LEN(B16)

18

=REPT(" ",B17)

19

=SUBSTITUTE(B16,",",B18)

20

=MID(B19,(3*B17)-(B17-1),B17)

21

=MID(B19,(3*B17)-(B17),B17)

_Row\^Col
A

B

C

7
I apply to B5 the MID function starting at (1x5)-(5)=0 and for a length of 5
#VALUE!
Excel doesn't forgive me for trying to start at 0 when using MID

_Row\^Col	A	B	C
1			What is pseudo is in the Cell to the left ( column B )
2	Example get the first thing, 1 from the Text string "1,3,5"	1,3,5	my original test text
3	Length	5	the length in characters of my original test text
4	( Rept " " ) x Length		5 spaces like "12345"
5	Substitute in the original string ( B2 ) 5 spaces for each comma seperator	1_____3_____5	like "1123453123455" is 13 characters
6	I apply to B5 the MID function starting at (1x5)-(5-1)=1 and for a length of 5	1____	like "11234"
7	I apply to B5 the MID function starting at (1x5)-(5)=0 and for a length of 5	#VALUE!	Excel doesn't forgive me for trying to start at 0 !!!!
8
9	Example get the second thing, 3 from the Text string "1,3,5"	1,3,5	my original test text
10	Length	5	the length in characters of my original test text
11	( Rept " " ) x Length		5 spaces like "12345"
12	Substitute in the original string ( B9 ) 5 spaces for each comma seperator	1_____3_____5	like "1123453123455" is 13 characters
13	I apply to B12 the MID function starting at (2x5)-(5-1)=6 and for a length of 5	_3___	like "13123"
14	I apply to B12 the MID function starting at (2x5)-(5)=5 and for a length of 5	__3__	like "12312"
15
16	Example get the third thing, 5 from the Text string "1,3,5"	1,3,5	my original test text
17	Length	5	the length in characters of my original test text
18	( Rept " " ) x Length		5 spaces like "12345"
19	Substitute in the original string ( B16 ) 5 spaces for each comma seperator	1_____3_____5	like "1123453123455" is 13 characters
20	I apply to B19 the MID function starting at (3x5)-(5-1)=11 and for a length of 5	__5	like "125" Note: I try to do length 5, but Excel forgives me and gives the 3 it has available
21	I apply to B19 the MID function starting at (1x5)-(5)=0 and for a length of 5	___5	like "1235" Note: I try to do length 5, but Excel forgives me and gives the 4 it has available

_Row\^Col	B
1
2	1,3,5
3	=LEN(B2)
4	=REPT(" ",B3)
5	=SUBSTITUTE(B2,",",B4)
6	=MID(B5,(1*B3)-(B3-1),B3)
7	=MID(B5,(1*B3)-(B3),B3)
8
9	1,3,5
10	=LEN(B9)
11	=REPT(" ",B10)
12	=SUBSTITUTE(B9,",",B11)
13	=MID(B12,(2*B10)-(B10-1),B10)
14	=MID(B12,(2*B10)-(B10),B10)
15
16	1,3,5
17	=LEN(B16)
18	=REPT(" ",B17)
19	=SUBSTITUTE(B16,",",B18)
20	=MID(B19,(3*B17)-(B17-1),B17)
21	=MID(B19,(3*B17)-(B17),B17)

_Row\^Col	A	B	C
7	I apply to B5 the MID function starting at (1x5)-(5)=0 and for a length of 5	#VALUE!	Excel doesn't forgive me for trying to start at 0 when using MID

MID( SUBSTITUTE(Text,Delim,REPT(" ",LEN(Text))) , element*LEN(Text)-(LEN(Text)-1) , LEN(Text) )

Test...

MID( SUBSTITUTE(Text,Delim,REPT(" ",LEN(Text))) , (element*LEN(Text)) - (LEN(Text)-1) , LEN(Text) )
MID( SUBSTITUTE(Text,Delim,REPT(" ",LEN(Text))) , (element*LEN(Text)) - ( LEN(Text) ) , LEN(Text) )

_Row\^Col
A

B

C

1
What is pseudo is in the Cell to the left ( column B )

2
Example get the first thing, 1 from the Text string "1,3,5"
1,3,5
my original test text

3
Length
5
the length in characters of my original test text

4
( Rept " " ) x Length 5 spaces like "12345"

5
Substitute in the original string ( B2 ) 5 spaces for each comma seperator
1_____3_____5
like "1123453123455" is 13 characters

6
I apply to B5 the MID function starting at (1x5)-(5-1)=1 and for a length of 5
1____
like "11234"

7
I apply to B5 the MID function starting at (1x5)-(5)=0 and for a length of 5
#VALUE!
Excel doesn't forgive me for trying to start at 0 !!!!

8

9
Example get the second thing, 3 from the Text string "1,3,5"
1,3,5
my original test text

10
Length
5
the length in characters of my original test text

11
( Rept " " ) x Length 5 spaces like "12345"

12
Substitute in the original string ( B9 ) 5 spaces for each comma seperator
1_____3_____5
like "1123453123455" is 13 characters

13
I apply to B12 the MID function starting at (2x5)-(5-1)=6 and for a length of 5
_3___
like "13123"

14
I apply to B12 the MID function starting at (2x5)-(5)=5 and for a length of 5
__3__
like "12312"

15

16
Example get the third thing, 5 from the Text string "1,3,5"
1,3,5
my original test text

17
Length
5
the length in characters of my original test text

18
( Rept " " ) x Length 5 spaces like "12345"

19
Substitute in the original string ( B16 ) 5 spaces for each comma seperator
1_____3_____5
like "1123453123455" is 13 characters

20
I apply to B19 the MID function starting at (3x5)-(5-1)=11 and for a length of 5
__5
like "125" Note: I try to do length 5, but Excel forgives me and gives the 3 it has available

21
I apply to B19 the MID function starting at (1x5)-(5)=0 and for a length of 5
___5
like "1235" Note: I try to do length 5, but Excel forgives me and gives the 4 it has available

_Row\^Col
B

1

2

1,3,5

3

=LEN(B2)

4

=REPT(" ",B3)

5

=SUBSTITUTE(B2,",",B4)

6

=MID(B5,(1*B3)-(B3-1),B3)

7

=MID(B5,(1*B3)-(B3),B3)

8

9

1,3,5

10

=LEN(B9)

11

=REPT(" ",B10)

12

=SUBSTITUTE(B9,",",B11)

13

=MID(B12,(2*B10)-(B10-1),B10)

14

=MID(B12,(2*B10)-(B10),B10)

15

16

1,3,5

17

=LEN(B16)

18

=REPT(" ",B17)

19

=SUBSTITUTE(B16,",",B18)

20

=MID(B19,(3*B17)-(B17-1),B17)

21

=MID(B19,(3*B17)-(B17),B17)

_Row\^Col
A

B

C

7
I apply to B5 the MID function starting at (1x5)-(5)=0 and for a length of 5
#VALUE!
Excel doesn't forgive me for trying to start at 0 when using MID

01-24-2021, 07:32 PM
DocAElstein

post to use later
01-24-2021, 07:32 PM
DocAElstein

post to use later

_Row\^Col	A	B	C
1			What is pseudo is in the Cell to the left ( column B )
2	Example get the first thing, 1 from the Text string "1,3,5"	1,3,5	my original test text
3	Length	5	the length in characters of my original test text
4	( Rept " " ) x Length		5 spaces like "12345"
5	Substitute in the original string ( B2 ) 5 spaces for each comma seperator	1_____3_____5	like "1123453123455" is 13 characters
6	I apply to B5 the MID function starting at (1x5)-(5-1)=1 and for a length of 5	1____	like "11234"
7	I apply to B5 the MID function starting at (1x5)-(5)=0 and for a length of 5	#VALUE!	Excel doesn't forgive me for trying to start at 0 !!!!
8
9	Example get the second thing, 3 from the Text string "1,3,5"	1,3,5	my original test text
10	Length	5	the length in characters of my original test text
11	( Rept " " ) x Length		5 spaces like "12345"
12	Substitute in the original string ( B9 ) 5 spaces for each comma seperator	1_____3_____5	like "1123453123455" is 13 characters
13	I apply to B12 the MID function starting at (2x5)-(5-1)=6 and for a length of 5	_3___	like "13123"
14	I apply to B12 the MID function starting at (2x5)-(5)=5 and for a length of 5	__3__	like "12312"
15
16	Example get the third thing, 5 from the Text string "1,3,5"	1,3,5	my original test text
17	Length	5	the length in characters of my original test text
18	( Rept " " ) x Length		5 spaces like "12345"
19	Substitute in the original string ( B16 ) 5 spaces for each comma seperator	1_____3_____5	like "1123453123455" is 13 characters
20	I apply to B19 the MID function starting at (3x5)-(5-1)=11 and for a length of 5	__5	like "125" Note: I try to do length 5, but Excel forgives me and gives the 3 it has available
21	I apply to B19 the MID function starting at (1x5)-(5)=0 and for a length of 5	___5	like "1235" Note: I try to do length 5, but Excel forgives me and gives the 4 it has available

_Row\^Col	B
1
2	1,3,5
3	=LEN(B2)
4	=REPT(" ",B3)
5	=SUBSTITUTE(B2,",",B4)
6	=MID(B5,(1*B3)-(B3-1),B3)
7	=MID(B5,(1*B3)-(B3),B3)
8
9	1,3,5
10	=LEN(B9)
11	=REPT(" ",B10)
12	=SUBSTITUTE(B9,",",B11)
13	=MID(B12,(2*B10)-(B10-1),B10)
14	=MID(B12,(2*B10)-(B10),B10)
15
16	1,3,5
17	=LEN(B16)
18	=REPT(" ",B17)
19	=SUBSTITUTE(B16,",",B18)
20	=MID(B19,(3*B17)-(B17-1),B17)
21	=MID(B19,(3*B17)-(B17),B17)

_Row\^Col	A	B	C
7	I apply to B5 the MID function starting at (1x5)-(5)=0 and for a length of 5	#VALUE!	Excel doesn't forgive me for trying to start at 0 when using MID

In support of this post

Before Source worksheet

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

_Row\^Col A B C D E F G H I J K L M N O P Q R S T U V W X Y Z AA AB AC AD AE AF AG AH

1 Number Unique ID Name Title Platform Filter Salary Add1 Add2 Add3 Add4 Add5 Add6 Add7 Add8 Add9 Add10 Add11 Add12 copy1 copy2 copy3 copy4 copy5 copy6 copy7 Total

4 3 3658 Lalu Lead C Filter2 300 0 6 6 0 6 0 6 0 0 0 0 0 0 0 1 1 2 0 4

9 2 563 Vidu_xx Manager Java Filter2 400 0 0 0 0 0 0 0 0 0 0 0 0 0 0 8 12 0 0 1 21

10 2 563 Vidu_max Manager Java Filter2 425 0 0 0 0 0 0 0 0 0 0 0 0 0 0 8 12 0 0 2 22

12 2 563 Vidu Manager Java Filter2 400 0 0 0 0 0 0 0 0 0 0 0 0 0 0 8 13 0 0 21

16 2 354 Sai Operator C++ Filter2 150 0 0 0 23 0 0 2 0 0 0 0 0 0 0 24 0 0 0 24

17 2 333 Fran Operator SQL Filter2 150 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0

18 3 239 Jack_max Lead SQL Filter2 566 0 0 0 0 0 0 0 45 0 0 0 0 4 4 0 8 4 0 20

19 3 239 Jack Lead SQL Filter2 300 0 0 0 0 0 0 0 46 0 0 0 0 4 4 4 8 4 0 24

23 4 222 Andy Operator Java Filter2 150 0 0 0 0 0 0 0 0 0 0 0 0 0 4 0 0 14 8 26

24 1 123 Ram Manager Java Filter2 400 0 0 3 0 0 0 0 0 0 55 0 0 12 0 0 0 0 3 15

36 1 26 Som Operator C Filter2 150 0 0 2 0 7 0 0 0 0 0 0 333 0 0 4 0 6 0 22 32

Worksheet: Sheet1

In support of this post

Before destination worksheet

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

_Row\^Col A B C D E F G H I J K L M N O P

1 Unique ID Name Title Platform Salary Sum copy1 copy2 copy3 copy4 copy5 copy6 copy7

2

Worksheet: Sheet1

Destination After

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

_Row\^Col
B

C

D

E

F

G

H

I

J

K

L

M

N

O

1

Unique ID

Name

Title

Platform

Salary

Sum

copy1

copy2

copy3

copy4

copy5

copy6

copy7

2
3658 Lalu Lead C
£300

24

1

1

2

3
563 Vidu_xx Manager Java
£400

0

8

12

1

4
563 Vidu_max Manager Java
£425

0

8

12

2

5
563 Vidu Manager Java
£400

0

8

13

6
354 Sai Operator C++
£150

25

24

7
333 Fran Operator SQL
£150

2

8
239 Jack_max Lead SQL
£566

45

4

4

8

4

9
239 Jack Lead SQL
£300

46

4

4

4

8

4

10
222 Andy Operator Java
£150

0

4

14

8

11
123 Ram Manager Java
£400

58

12

3

12
26 Som Operator C
£150

342

4

6

22

Worksheet: Sheet1

01-24-2021, 07:33 PM
DocAElstein

Macro for last two posts

Code:

' https://www.excelforum.com/excel-programming-vba-macros/1338596-transferring-data.html#post5458446 ' _ First i wanted to filter column G from workbook 1 to "Filter 2" and transfer only filter 2 data to workbook 2. ' _ Then transferring like i wanted to transfer column C (source) to column B (destination) , column D to D, Column L to Column G, etc. ' _ I wanted to sum from column P to colum AA and transfer those sum to destination at column H ' _ Then copy from column AB to AH and paste in I to O in destination Sub Transfer_maras_1() Dim a(), arrOut__(), Cls(), Cls_v() As String, Rws(), asum Dim Rng As Range, Rng_v As Range, Rng_vVls() As Variant, cel As Range Dim i As Integer, ii As Integer Dim Pth As String: Let Pth = ThisWorkbook.Path & Application.PathSeparator ' Const pth = "c:\Users\User\Downloads\" '<---- use own path Const wnm = "Workbook2_1.xlsx" 'your workbook name Rem 1 the main data range from source With ThisWorkbook.Sheets("Sheet1") Set Rng = Range("a1:aH" & 36 & "") ' Range("a1:ag" & 36 & "") ' hard coded for testing .UsedRange.Rows.Count) Let a() = Rng.Value ' The main source data range Let Cls() = Rng.Rows(1).Value ' The header row ReDim Rws(1 To UBound(a)) ' The row indicies of the rows we are intersted in from the filtered range ##### this will likely be much too big at this stage but we will correct that later End With Rem 2 building a single column array for the summed colums Set Rng_v = Rng.Columns(2).SpecialCells(xlCellTypeVisible) ' for maras datas this will be 11 data rows and the header 0 12 rows in total 'Rng_vVls() = Rng_v.Value2 ' This is for my testing only - this will give me just first area If Rng_v.Count > 1 Then ReDim asum(1 To Rng_v.Count) ' 1 D array to hold sum values - I wanted to sum from column O to column Z and transfer those sum to destination at column I For Each cel In Rng_v If cel.Row > 1 And cel.Value <> "" Then Let ii = ii + 1 Let asum(ii) = Evaluate("sum(o" & cel.Row & ": z" & cel.Row & ")") ' Evaluate Range way to sum a range Let i = i + 1 Let Rws(i) = cel.Row End If Next If ii > 0 Then ReDim Preserve asum(1 To ii) ' Our array is one element too big with an empty element, so thhis takes off that extra unwanted element If i > 0 Then ReDim Preserve Rws(1 To i) ' Our array is much too big so this makes it the correct size #### Else ' case no data rows, only a header row End If If Rng_v.Count = 1 Or i = 0 Then MsgBox "No rows to transfer." Exit Sub End If Rem 2 Workbooks.Open Filename:=Pth & wnm '2a) Gets the column indicies of the columns wanted from the data worksheet With ActiveWorkbook With .Sheets("Sheet1") Dim vTemp As Variant vTemp = Application.Match(.UsedRange.Rows(1), Rng.Rows(1), 0) ' This gives a 1 D array and each element has either the position of the header in the destination workbook, or an error if it did not find it ' { 2 , error , 3 , 4 , 5 , 11 , error , 27 , 28 , 29 , 30 , 31 , 32 , 33 } ' So the above line tells us where there is an error in a match with the header names Let vTemp = Application.IfError(vTemp, "x") ' Instead of the vbError , a text of "x" is put into the array ' { 2 , x , 3 , 4 , 5 , 11 , x , 27 , 28 , 29 , 30 , 31 , 32 , 33 } Let vTemp = Filter(vTemp, "x", False, 0) ' take out the "x"s ' { 2 , x , 3 , 4 , 5 , 11 , x , 27 , 28 , 29 , 30 , 31 , 32 , 33 } Let Cls_v() = Filter(Application.IfError(Application.Match(.UsedRange.Rows(1), Rng.Rows(1), 0), "x"), "x", False, 0) ' { 2 , 3 , 4 , 5 , 11 , 27 , 28 , 29 , 30 , 31 , 32 , 33 } '2b) Typical arrOut()=AppIndex(arrIn(), Rws(), Clms()) Let arrOut__() = Application.Index(a(), Application.Transpose(Rws()), Cls_v()) ' Typical arrOut()=AppIndex(arrIn(), Rws(), Clms()) '2c) arrOut__() is not quite the final array we want. Its condensed missing out a couple of empty columns, so in code section '2b) we pick out the sections we want and put them in the appropriate place. With .Range("B2") ' UsedRange.Offset(1) '.ClearContents .Resize(UBound(Rws()), 1) = Application.Index(arrOut__(), Evaluate("row(1:" & UBound(Rws()) & ")"), 1) ' column B in output .Offset(, 2).Cells(1).Resize(UBound(Rws()), 4).Value = Application.Index(arrOut__(), (Evaluate("row(1:" & UBound(Rws()) & ")")), Application.Transpose(Evaluate("row(2:" & UBound(arrOut__(), 2) & ")"))) ' column D to G .Offset(, 7).Cells(1).Resize(UBound(Rws()), UBound(arrOut__(), 2) - 5).Value = Application.Index(arrOut__(), Evaluate("row(1:" & UBound(Rws()) & ")"), Application.Transpose(Evaluate("row(6:" & UBound(arrOut__(), 2) & ")"))) ' column I to O .Offset(, 6).Cells(1).Resize(UBound(Rws())) = Application.Transpose(asum) ' sums column H End With End With '.Save End With ' Set Rng = Nothing ' Set Rng_v = Nothing End Sub

_._______________________________

Here is a before and after…
https://excelfox.com/forum/showthrea...ll=1#post15278
https://excelfox.com/forum/showthrea...ll=1#post15279

Macro
https://excelfox.com/forum/showthrea...ll=1#post15277

Files
Transfer data_marasAlan_1.xlsm : https://app.box.com/s/p8kf5vo8jesql3n47sd1bzgm57qdpwdv
Workbook2_1.xlsx : https://app.box.com/s/3d9gmeb2nlyr4gg9q802kk5mjgze8cl5

_Row\^Col	B	D	E	F	G	H	I	J	K	L	M	N	O
1	Unique ID	Name	Title	Platform	Salary	Sum	copy1	copy2	copy3	copy4	copy5	copy6	copy7
2	3658	Lalu	Lead	C	£300	24			1	1	2
3	563	Vidu_xx	Manager	Java	£400	0			8	12			1
4	563	Vidu_max	Manager	Java	£425	0			8	12			2
5	563	Vidu	Manager	Java	£400	0			8	13
6	354	Sai	Operator	C++	£150	25			24
7	333	Fran	Operator	SQL	£150	2
8	239	Jack_max	Lead	SQL	£566	45	4	4		8	4
9	239	Jack	Lead	SQL	£300	46	4	4	4	8	4
10	222	Andy	Operator	Java	£150	0		4			14	8
11	123	Ram	Manager	Java	£400	58	12					3
12	26	Som	Operator	C	£150	342			4		6		22

In support of this post

Source Workbook

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

_Row\^Col A B C D E F G H I J K L M N O P Q R S T U V W X Y Z AA AB AC AD AE AF AG AH AI

1 Number Unique ID Name Title Platform Filter Salary Add1 Add2 Add3 Add4 Add5 Add6 Add7 Add8 Add9 Add10 Add11 Add12 copy1 copy2 copy3 copy4 copy5 copy6 copy7

2 1 123 Ram Manager Java Filter2 £400 3 55 12 3 222

9 1 26 Som Operator C Filter2 £150 1,013

10 2 354 Sai Operator C++ Filter2 £150 23 2 24 1,126

17 2 563 Vidu Manager Java Filter2 £400 8 12 147

18 3 239 Jack Lead SQL Filter2 £300 45 4 4 8 4 149

19 4 222 Andy Operator Java Filter2 £150 4 14 8 151

24 2 333 Fran Operator SQL Filter2 £150 1 1 161

25 3 3658 Lalu Lead C Filter2 £300 6 6 6 6 1 1 2 163

30

31

Worksheet: Sheet1

In support of this post

Designation workbook before

_____ Workbook: Workbook2_2.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 Unique ID Gap Name Title Platform Salary Gap Total copy1 copy2 copy3 copy4 copy5 copy6 copy7

2

Worksheet: sheet1

Destination workbook after running macro Sub Transfer_marasAlan_2()

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

_Row\^Col B C D E F G H I J K L M N O P

1 Unique ID Gap Name Title Platform Salary Gap Total copy1 copy2 copy3 copy4 copy5 copy6 copy7

2 123 Ram Manager Java £400 58 12 3 222

3 26 Som Operator C £150 0 1,013

4 354 Sai Operator C++ £150 25 24 1,126

5 563 Vidu Manager Java £400 0 8 12 147

6 239 Jack Lead SQL £300 45 4 4 8 4 149

7 222 Andy Operator Java £150 0 4 14 8 151

8 333 Fran Operator SQL £150 2 161

9 3658 Lalu Lead C £300 24 1 1 2 163

10

Worksheet: sheet1

01-24-2021, 07:33 PM
DocAElstein

macro for last two posts

Code:

Option Explicit Sub Transfer_marasAlan_2() ' Dim a(), Cls(), Cls_v() As String, Rws(), aSum(), arrOut__() Dim Rng As Range, Rng_v As Range, Cel As Range, WbDest As Workbook Dim i As Integer, ii As Integer Dim Pth As String Let Pth = ThisWorkbook.Path & Application.PathSeparator ' Const Pth = "C:\Users\L026936\Desktop\Excel\" '<---- use own path Const wnm = "Workbook2_2.xlsx" 'your workbook name ' Application.ScreenUpdating = False Rem 1 the main data range from source With ThisWorkbook.Sheets("Sheet1") Set Rng = .Range("a1:ag" & 25 & "") ' Hardcoded for demonstration purposes .UsedRange.Rows.Count) Let a() = Rng.Value ' main complete data range Let Cls() = Rng.Rows(1).Value ' header row array ReDim Rws(1 To UBound(a)) ' This will be much too big initially - its the full all row size, but we will only want a reduced filtered number of rows - later #### this will be corrected End With Set Rng_v = Rng.Columns(2).SpecialCells(xlCellTypeVisible) ' this gets just the range we see, so will be likely a range of lots of areas If Rng_v.Count > 1 Then Rem 2 building a single column array for the summed colums ReDim aSum(1 To Rng_v.Count) ' this is "one row too big" ** For Each Cel In Rng_v If Cel.Row > 1 And Cel.Value <> "" Then Let i = i + 1 Let aSum(i) = Evaluate("sum('[Transfer data_marasAlan_2.xlsm]Sheet1'!o" & Cel.Row & ": '[Transfer data_marasAlan_2.xlsm]Sheet1'!z" & Cel.Row & ")") Let Rws(i) = Cel.Row End If Next If i > 0 Then ReDim Preserve aSum(1 To i) ' ** this sets the correct size ReDim Preserve Rws(1 To i) ' #### this sets just enought row size for our final output array Let aSum() = Application.Transpose(aSum()) ' we need a "virtical" "column" array Let Rws() = Application.Transpose(Rws()) ' we need a virtical array in the second argumant of the Typical arrOut()=AppIndex(arrIn(), Rws(), Clms()) code line End If Else ' case only header range visible End If If Rng_v.Count = 1 Or i = 0 Then MsgBox "No rows to transfer." Exit Sub End If On Error Resume Next ' https://eileenslounge.com/viewtopic.php?f=30&t=35861&start=20 Set WbDest = Workbooks(wnm) ' will error if workbook is not yet open If Err.Number > 0 Then Workbooks.Open Filename:=Pth & wnm ' we test to see if we have an error and if we do themn we kknow to open the workbook On Error GoTo 0 Set WbDest = ActiveWorkbook '2a) Gets the column indicies of the columns wanted from the data worksheet With WbDest ' ActiveWorkbook With .Sheets("Sheet1") Dim vTemp As Variant ' just for demo purposes Let vTemp = Application.Match(.UsedRange.Rows(1), Rng.Rows(1), 0) ' This gives a 1 D array and each element has either the position of the header in the destination workbook, or an error if it did not find it ' { 2 , error , 3 , 4 , 5 , 11 , error , error , 27 , 28 , 29 , 30 , 31 , 32 , 33 } ' So the above line tells us where there is an error in a match with the header names Let vTemp = Application.IfError(vTemp, "x") ' Instead of the vbError , a text of "x" is put into the array ' { 2 , x , 3 , 4 , 5 , 11 , x , x, , 27 , 28 , 29 , 30 , 31 , 32 , 33 } Let vTemp = Filter(vTemp, "x", False, 0) ' take out the "x"s ' { 2 , 3 , 4 , 5 , 11 , 27 , 28 , 29 , 30 , 31 , 32 , 33 } Let Cls_v() = Filter(Application.IfError(Application.Match(.UsedRange.Rows(1), Rng.Rows(1), 0), "x"), "x", False, 0) ' { 2 , 3 , 4 , 5 , 11 , 27 , 28 , 29 , 30 , 31 , 32 , 33 } '2b) Typical arrOut()=AppIndex(arrIn(), Rws(), Clms()) Let arrOut__() = Application.Index(a(), Rws(), Cls_v()) '2c) arrOut__() is not quite the final array we want. Its condensed missing out a couple of empty columns, so in code section '2c) we pick out the sections we want and put them in the appropriate place. In addition we paste in the sum columns that we got in section Rem 2 With Range("B2") ' .UsedRange.Offset(1) .Resize(UBound(Rws), 1) = arrOut__() ' arrOut__() is 8 columns, but this linw will just put the first column in Let Rws() = Evaluate("row(1:" & UBound(arrOut__()) & ")") ' for convenience again we are using the variable Rws() for sequential rows for our arrOut__() as we want all rows in the order that they are there .Offset(, 2).Cells(1).Resize(UBound(arrOut__()), 4).Value = Application.Index(arrOut__(), Rws(), Array(2, 3, 4, 5)) ' columns D to G .Offset(, 8).Cells(1).Resize(UBound(Rws()), UBound(arrOut__(), 2) - 5).Value = Application.Index(arrOut__(), Rws(), Array(6, 7, 8, 9, 10, 11, 12)) ' columns J to P .Offset(, 7).Cells(1).Resize(UBound(Rws())) = aSum() ' put the totals column in I End With End With ' .Save End With ' Set Rng = Nothing ' Set Rng_v = Nothing End Sub

_._______________________________

Here is a before and after…
https://excelfox.com/forum/showthrea...ll=1#post15276
https://excelfox.com/forum/showthrea...ll=1#post15273

Macro
https://excelfox.com/forum/showthrea...ll=1#post15272

Files
Transfer data_marasAlan_2.xlsm : https://app.box.com/s/749a78z2ku4m1s1tg3fvgs1z1ud4s325
Workbook2_2.xlsx : https://app.box.com/s/13yh30a77spsluauck3nif309pic8fuz

_Row\^Col	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1	Unique ID	Gap	Name	Title	Platform	Salary	Gap	Total	copy1	copy2	copy3	copy4	copy5	copy6	copy7
2	123		Ram	Manager	Java	£400		58	12					3	222
3	26		Som	Operator	C	£150		0							1,013
4	354		Sai	Operator	C++	£150		25			24				1,126
5	563		Vidu	Manager	Java	£400		0			8	12			147
6	239		Jack	Lead	SQL	£300		45	4	4		8	4		149
7	222		Andy	Operator	Java	£150		0		4			14	8	151
8	333		Fran	Operator	SQL	£150		2							161
9	3658		Lalu	Lead	C	£300		24			1	1	2		163
10

In support of this post

Source Workbook

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

_Row\^Col A B C D E F G H I J K L M N O P Q R S T U V W X Y Z AA AB AC AD AE AF AG AH AI

1 Number Unique ID Name Title Platform Filter Salary Add1 Add2 Add3 Add4 Add5 Add6 Add7 Add8 Add9 Add10 Add11 Add12 copy1 copy2 copy3 copy4 copy5 copy6 copy7 Total grandtotal

4 3 3658 Lalu Lead C Filter2 £300 6 6 6 6 1 1 2
4

£1,200

9 2 563 Vidu Manager Java Filter2 £400 8 12
20

£8,000

10 2 563 Vidu Manager Java Filter2 £425 8 12
20

£8,500

12 2 563 Vidu Manager Java Filter2 £400 8 13
21

£8,400

16 2 354 Sai Operator C++ Filter2 £150 23 2 24
24

£3,600

17 2 333 Fran Operator SQL Filter2 £150 1 1
£0

18 3 239 Jack Lead SQL Filter2 £566 45 4 4 8 4
20

£11,320

19 3 239 Jack Lead SQL Filter2 £300 46 4 4 4 8 4
24

£7,200

23 4 222 Andy Operator Java Filter2 £150 4 14 8
26

£3,900

24 1 123 Ram Manager Java Filter2 £400 3 55 12 3
15

36 1 26 Som Operator C Filter2 £150

Worksheet: Sheet1

In support of this post

Before destination

_____ Workbook: Workbook2_3.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 R S T

1 Unique ID Gap Name Title Platform Salary Gap Total copy1 copy2 copy3 copy4 copy5 copy6 copy7

2

Worksheet: Sheet1

After Destination

_____ Workbook: Workbook2_3.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 R S

1 Unique ID Gap Name Title Platform Salary Gap Total copy1 copy2 copy3 copy4 copy5 copy6 copy7

2 3658 Lalu Lead C £300 24 4 1 1 2

3 563 Vidu Manager Java £425 0 20 8 12

4 354 Sai Operator C++ £150 25 24 24

5 333 Fran Operator SQL £150 2

6 239 Jack Lead SQL £566 45 20 4 4 8 4

7 222 Andy Operator Java £150 0 26 4 14 8

8 123 Ram Manager Java £400 58 15 12 3

9 26 Som Operator C £150 0

10

Worksheet: Sheet1

01-24-2021, 07:33 PM
DocAElstein

macro for last two posts

Code:

Option Explicit Sub Transfer_marasAlan_3() ' https://www.excelforum.com/excel-programming-vba-macros/1338596-transferring-data.html#post5460624 Dim a(), cls_v() As String, Rws(), aSum(), arrOut__(), JagdDikIt() Dim Rng As Range, Rng_v As Range, cel As Range Dim Wrbk As Workbook, Rw As Long Dim Pth As String Let Pth = ThisWorkbook.Path & Application.PathSeparator ' Const pth = "C:\Users\L026936\Desktop\Excel\" '<---- use own path Const Wnm = "Workbook2_3.xlsx" 'your workbook name ' Application.ScreenUpdating = False Rem 1 the main data range from source With ThisWorkbook.Sheets("Sheet1") Set Rng = .Range("a1:ai" & 36 & "") ' main data range hard coded to 36 for testing and demonstration .UsedRange.Rows.Count) Let a() = Rng.Value ' all data values in the source. This will end up in the tyopical arrOut()=AppIndex( a(), Rws(), Clms() ) Set Rng_v = Rng.Columns(2).SpecialCells(xlCellTypeVisible) ' this gives us the range we see , (it is likely as a collection of areas) in the ID column If Rng_v.Count > 1 Then Rem 2 Make the sums column array, aSum() , and while we are looping we will collect the seen row indicies, Rws() ' ' ddddddddddddddddddddddd Dictionaray bit ------ ' Dictionaray - The only reason to use this is that its a convenient way to get a unique list thing, or a unique set of things. Dim Dik As Object: Set Dik = CreateObject("Scripting.Dictionary") ' https://excelmacromastery.com/vba-dictionary/ 'Dim d As Scripting.Dictionary: Set d = New Scripting.Dictionary Dim aTp() As Variant: ReDim aTp(1 To 3) ' This is a temporary array used to fill the dictionary Items it must be dynamic and variant type - see note +++ below For Each cel In Rng_v ' we effectivelly are going down all the seen rows If cel.Row > 1 And cel.Value <> "" Then Let Rw = cel.Row If Not Dik.exists(a(Rw, 2)) Then ' -Case we don't yet have any dictionaray item with this ID key Let aTp(1) = Rw ' row number Let aTp(2) = a(Rw, 35) ' grangtotal for this row Let aTp(3) = .Evaluate("=Sum(o" & Rw & ": z" & Rw & ")") ' Our column Sums Dik.Add Key:=a(Rw, 2), Item:=aTp() ' The key becomes the ID , The Item is a three element array of the row number the columns sum for this row the gradtotal for this row shothand way to do this line is d(a(r, 2)) = atp Else ' ' -Case we already have a dictionary item with this key Let aTp() = Dik.Item(a(Rw, 2)) ' we are returning an item that is an array, so the recieving array variable must be dynamic. the returned element type3s are Variant +++ If a(Rw, 35) > aTp(2) Then ' If the grand total for this row and ID is greater than a previous, then .... Let aTp(1) = Rw ' we are replacing .. Let aTp(2) = a(Rw, 35) ' .. the item with the relavent .. Let aTp(3) = .Evaluate("=Sum(o" & Rw & ": z" & Rw & ")") ' .. info from this row Dik(a(Rw, 2)) = aTp() ' shorthand version for Dik.Add Key:=a(Rw, 2), Item:=aTp() End If End If ' end of making or replacing a dictiuonary item Else End If Next ' at this point we have a dictionary that has one Item for each ID ' in this last Dik bit we use the first and third part of the 3 element items in a pseudo arrOut()=AppIndex( arrUnjaggedJaged(), Rws() , Clms() ) ' https://www.ozgrid.com/forum/index.php?thread/1227920-slicing-a-2d-array/&postID=1239241#post1239241 If Dik.Count Then 'Let JagdDikIt() = Application.Transpose(Dik.items()) ' we can treat an unjagged jagged array that is a 1 D array of 1 D arrays as if it was a 2 D array ... https://eileenslounge.com/viewtopic.php?p=266691#p266691 Let JagdDikIt() = Dik.items() 'Let Rws() = Application.Index(JagdDikIt(), 1, Evaluate("row(1:" & UBound(JagdDikIt(), 2) & ")")) ' Application.Transpose(Application.Transpose(Application.Index(v, 1, Evaluate("row(1:" & UBound(v, 2) & ")")))) Let Rws() = Application.Index(JagdDikIt(), Evaluate("row(1:" & UBound(JagdDikIt()) + 1 & ")"), 1) ' Application.Transpose(Application.Transpose(Application.Index(v, 1, Evaluate("row(1:" & UBound(v, 2) & ")")))) 'Let aSum() = Application.Index(JagdDikIt(), 3, Evaluate("row(1:" & UBound(JagdDikIt(), 2) & ")")) 'Application.Transpose(Application.Transpose(Application.Index(v, 3, Evaluate("row(1:" & UBound(v, 2) & ")")))) Let aSum() = Application.Index(JagdDikIt(), Evaluate("row(1:" & UBound(JagdDikIt()) + 1 & ")"), 3) 'Application.Transpose(Application.Transpose(Application.Index(v, 3, Evaluate("row(1:" & UBound(v, 2) & ")")))) ' ' ddddddddddddddddddddddddd ----------------------------- Else End If Else ' case only a header row to be seen End If End With If Rng_v.Count = 1 Or Dik.Count = 0 Then MsgBox "No rows to transfer." Exit Sub End If On Error Resume Next ' https://eileenslounge.com/viewtopic.php?f=30&t=35861&start=20 Set Wrbk = Workbooks(Wnm) If Wrbk Is Nothing Then Workbooks.Open Filename:=Pth & Wnm Else Workbooks(Wnm).Activate End If On Error GoTo 0 With ActiveWorkbook With .Sheets("Sheet1") Dim vTemp As Variant ' just for demo purposes Let vTemp = .UsedRange.Rows(1) ' { empty , Unique ID , Gap ,Name , Title , Platform , Salary , Gap, Total , copy1 , copy2 , copy3 , copy4 , copy5 , copy6 , copy7 , copy2 , copy3 , copy4 , copy5 , copy6 , copy7 , Formula7 , Formula8 , Formula9 } Let vTemp = Rng.Rows(1) ' { Number , ID , Name , Title , Platform , Filter , , , , ,Salary , , , ,Add1 , Add2 , Add3 , Add4 , Add5 , Add6 , Add7 , Add8 , Add9 , Add10 , Add11 , Add12 , copy1 , copy2 , copy3 , copy4 , copy5 , copy6 , copy7 , Total , grandtotal } Let vTemp = Application.Match(.UsedRange.Rows(1), Rng.Rows(1), 0) ' This gives a 1 D array and each element has either the position of the header in the destination workbook, or an error if it did not find it ' { 2 , error , 3 , 4 , 5 , 11 , error , 34 , 27 , 28 , 29 , 30 , 31 , 32 , 33 , 28 , error ,error ,error ,error ,error ,error ,error ,error ,error , } ' So the above line tells us where there is an error in a match with the header names Let vTemp = Application.IfError(vTemp, "x") ' Instead of the vbError , a text of "x" is put into the array ' { 2 , x , 3 , 4 , 5 , 11 , x , 34 , 27 , 28 , 29 , 30 , 31 , 32 , 33 , x ,x ,x ,x ,x ,x ,x ,x ,x , } Let vTemp = Filter(vTemp, "x", False, 0) ' take out the "x"s ' { 2 , 3 , 4 , 5 , 11 , 34, 27 , 28 , 29 , 30 , 31 , 32 , 33 } Let cls_v() = Filter(Application.IfError(Application.Match(.UsedRange.Rows(1), Rng.Rows(1), 0), "x"), "x", False, 0) ' { 2 , 3 , 4 , 5 , 11 , 27 , 28 , 29 , 30 , 31 , 32 , 33 } With .Range("B2") ' .UsedRange.Offset(1) ' .Resize(, 15).ClearContents Let arrOut__() = Application.Index(a(), Rws(), cls_v()) .Resize(UBound(Rws()), 1) = arrOut__() Let Rws() = Evaluate("row(1:" & UBound(Rws()) & ")") ' Using the variable Rws() for a sequential indicie list 1; 2; 3 ... etc for all rows in the arrOut__() .Offset(, 2).Cells(1).Resize(UBound(Rws()), 4).Value = Application.Index(arrOut__(), Rws(), Array(2, 3, 4, 5)) ' columns D - G .Offset(, 7).Cells(1).Resize(UBound(Rws())) = aSum() ' columm I .Offset(, 8).Cells(1).Resize(UBound(Rws()), 7).Value = Application.Index(arrOut__(), Rws(), Array(6, 7, 8, 9, 10, 11, 12)) ' Column J to P End With End With ' .Save End With ' Set Rng = Nothing ' Set Rng_v = Nothing ' Set cel = Nothing Set Dik = Nothing End Sub

Show 40 post(s) from this thread on one page

All times are GMT +5. The time now is 03:34 PM.

ExcelFox is Not Associated With Microsoft®

_Row\^Col	A	B	C	D	E	F	K	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH
1	Number	Unique ID	Name	Title	Platform	Filter	Salary	Add1	Add2	Add3	Add4	Add5	Add6	Add7	Add8	Add9	Add10	Add11	Add12	copy1	copy2	copy3	copy4	copy5	copy6	copy7	Total
4	3	3658	Lalu	Lead	C	Filter2	300	0	6	6	0	6	0	6	0	0	0	0	0	0	0	1	1	2	0		4
9	2	563	Vidu_xx	Manager	Java	Filter2	400	0	0	0	0	0	0	0	0	0	0	0	0	0	0	8	12	0	0	1	21
10	2	563	Vidu_max	Manager	Java	Filter2	425	0	0	0	0	0	0	0	0	0	0	0	0	0	0	8	12	0	0	2	22
12	2	563	Vidu	Manager	Java	Filter2	400	0	0	0	0	0	0	0	0	0	0	0	0	0	0	8	13	0	0		21
16	2	354	Sai	Operator	C++	Filter2	150	0	0	0	23	0	0	2	0	0	0	0	0	0	0	24	0	0	0		24
17	2	333	Fran	Operator	SQL	Filter2	150	0	0	1	0	0	0	0	0	0	0	0	1	0	0	0	0	0	0		0
18	3	239	Jack_max	Lead	SQL	Filter2	566	0	0	0	0	0	0	0	45	0	0	0	0	4	4	0	8	4	0		20
19	3	239	Jack	Lead	SQL	Filter2	300	0	0	0	0	0	0	0	46	0	0	0	0	4	4	4	8	4	0		24
23	4	222	Andy	Operator	Java	Filter2	150	0	0	0	0	0	0	0	0	0	0	0	0	0	4	0	0	14	8		26
24	1	123	Ram	Manager	Java	Filter2	400	0	0	3	0	0	0	0	0	0	55	0	0	12	0	0	0	0	3		15
36	1	26	Som	Operator	C	Filter2	150	0	0	2	0	7	0	0	0	0	0	0	333	0	0	4	0	6	0	22	32

_Row\^Col	A	B	C	D	E	F	K	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG
1	Number	Unique ID	Name	Title	Platform	Filter	Salary	Add1	Add2	Add3	Add4	Add5	Add6	Add7	Add8	Add9	Add10	Add11	Add12	copy1	copy2	copy3	copy4	copy5	copy6	copy7
2	1	123	Ram	Manager	Java	Filter2	£400			3							55			12					3	222
9	1	26	Som	Operator	C	Filter2	£150																			1,013
10	2	354	Sai	Operator	C++	Filter2	£150				23			2								24				1,126
17	2	563	Vidu	Manager	Java	Filter2	£400															8	12			147
18	3	239	Jack	Lead	SQL	Filter2	£300								45					4	4		8	4		149
19	4	222	Andy	Operator	Java	Filter2	£150														4			14	8	151
24	2	333	Fran	Operator	SQL	Filter2	£150			1									1							161
25	3	3658	Lalu	Lead	C	Filter2	£300		6	6		6		6								1	1	2		163
30
31