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

5 Attachment(s)

Search for text in txt File using VBA, display rows where text found

Code in support of these Threads:
http://www.excelfox.com/forum/showth...0582#post10582

What code does in General:
This code will search for specific text in a text file
What code does in Specifically:
The code assumes that you have a simple text file looking something like this:
TextRowsInTextFile.jpg : https://imgur.com/upBY709
Attachment 2031
HotFixID
{EF8CD7FC-438D-49E3-A2C7-201052D9F2EF}
{8D2CDFAB-0079-43CC-A289-2F7A67F0A4DE}
{98D8F490-1F42-4F29-A59B-BF96D23A11BA}
{B730F010-3FCF-4E80-8A5A-C1DBEC0CF55A}
{B73E5AF4-40C6-4EA9-8F57-CFA70CC72BD6}
{BF11577A-6876-45AA-86C9-2BA4CFB8B019}
{E359D786-B101-4545-B8AB-8652323CF3CA}
{F4139440-5426-4C6F-909B-F71CEB1071B1}
{B2FAD7E1-67F9-435D-98BD-A77DBF4E1381}

Here is the example text file used in this explanation and currently hard coded into the code : “UpdatesOnVistaAspire4810TZG25thMarch.txt” : https://app.box.com/s/z90o8yj7iz0188yci34mu7gahe2tfhce

You can input , when prompted, a text string or text strings to look for. For more than one text string you should separate them by at least one space, like
__ B23 ___6872 35689
( The code below has those actual strings hard coded as the default search values )
Input Box Functioning.jpg : https://imgur.com/o9wlnhK https://imgur.com/JtnTDmy
Attachment 2030 Attachment 2034

The code will look for those text strings in all text file lines except the first.
( there is also a section to check the content of the first line, but it is 'commented out in the code below )
The code searches for those lines which contain any of those strings. In this demo example, one thing that I would be looking for is the rows in the text file containing B23 in them, so that would be the middle few in this screenshot .. B23 TextRowsInTextFile.JPG : https://imgur.com/JHRqJJc
Attachment 2032

The final result of the codes is to give you a string message which has a list of the text strings that you were looking for, and a list of the full text in any rows which contained that. The string is displayed in a message box. In addition if you are in the VB Editor Window and hit Ctrl+g , the you will see the results also in the immediate window. This latter has the advantage that you can copy the data to the clipboard by highlighting it and hitting Ctrl+c , ( or alternatively select the text and select the option to copy available via right mouse click ) : YouLookedForFindedWas.JPG: https://imgur.com/tyW4HSJ
Attachment 2033

Here is the code. It should be pasted into any File which is in the same Folder as the text file you want to search through. Currently the code is hard coded to search the file with name
“UpdatesOnVistaAspire4810TZG25thMarch.txt”
So you will need to change that to suit your text file name.

Code:

Sub CheqUpDates() On Error GoTo GetLaid ' Instruction to replace / modify VBA default error handler by hanging on to the arousal this code starting from the labelled label code area Rem 1) ActiviaExcretionLink, AEL. Checking Object link mechanismus '1a) Exposing of interfaces for active RunableTimed data axctivated link Dim ActiviEL As String ' "Pointer" to a "Blue Print" (or Form, Questionnaire not yet filled in, a template etc.)"Pigeon Hole" in Memory, sufficient in construction to house a piece of Paper with code text giving the relevant information for the particular Variable Type. VBA is sent to it when it passes it. In a Routine it may be given a particular “Value”, or (“Values” for Objects). There instructions say then how to do that and handle(store) that(those). At Dim the created Paper is like a Blue Print that has some empty spaces not yet filled in. A String is a bit tricky. The Blue Print code line Paper in the Pigeon Hole will allow to note the string Length and an Initial start memory Location. This Location well have to change frequently as strings of different length are assigned. Instructions will tell how to do this. Theoretically a special value vbNullString is set to aid in quick checks.. But..http://www.mrexcel.com/forum/excel-questions/361246-vbnullstring-2.html#post44116 Let ActiviEL = ThisWorkbook.Path & "\UpdatesOnVistaAspire4810TZG25thMarch.txt" 'Will be referrenced in code through an opened "route" to it Dim LedgerFreiNummer As String: Let LedgerFreiNummer = "1" & "00" ' Not required in this code : https://www.excelforum.com/excel-general/1225401-value-of-true-1-or-1-vba-vs-worksheet.html Dim AEL_Highway As Long: Let AEL_Highway = FreeFile("" & LedgerFreiNummer & "") ' Obtain from 2nd building phase (256-511) Ledger of available Highways, coercidentally to value 1_255 likely , bits of my 1 & 00 Rem 2) text file info ' '2a) Open File read first line check the sht - want Head ' Open ActiviEL For Input As AEL_Highway ' ' Dim ShtHead As String ' Line Input #AEL_Highway, ShtHead ' Check substancialating for getting good Head ' If InStr(1, ShtHead, "HotFix", vbTextCompare) = 0 Then ' MsgBox prompt:="Got no HotFix IDin " & ShtHead ' Exit Sub ' Else ' Debug.Print ShtHead ' End If ' Close AEL_Highway ' Datei scheißen '2b) "row" count in text file Dim RecardRows As Long ' '_-' Long is very simple to handle, - final memory "size" type is known (123.456 and 000.001 have same "size" computer memory ) , and so a Address suggestion can be given for the next line when the variable is filled in. '( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. ) https://www.mrexcel.com/forum/excel-questions/803662-byte-backward-loop-4.html Let RecardRows = 0 Dim strLine As String Open ActiviEL For Input As AEL_Highway ' Activated embedded Link objectimocom Binary as to referencingmocomed aka AliAs AEL_Highway opened of now Do Until EOF(AEL_Highway) 'Looping all lines in text file ' Solange bis Datei-Ende - EOF(AEL_Highway) will be set to true by the last a carriage liney mo not found a next line in Line Input #AEL_Highway, strLine Line Input #AEL_Highway, strLine: Let RecardRows = RecardRows + 1 ' Inputed der liney mo a carriage returned after then record register count of it to that increase by the one done liney mo Loop 'Do Until EOF(AEL_Highway) 'Looping all lines in text file 'Let RecardRows = RecardRows + 1 'would need to do this if I did not closeat '2a) and reopen in '2b) Close AEL_Highway ' Datei scheißen - scheise drauf der Highway geschnmut - no longer activamoed AEL not activia mated mo Rem 3) Prepare output Array for all text File data Dim arrOut() As String: ReDim arrOut(1 To RecardRows) ' can declare to known size and type. We cannot use Dim arrOut(1 to RecardRows) as pre complie compile cannot do the RecardRows is not available: method ReDim is Runtime Rem 4) Main loop for filling in Output Data ============================================= Open ActiviEL For Input As AEL_Highway Dim RecardRow As Long ', strLine As String For RecardRow = 1 To RecardRows '(Do Until EOF(AEL_Highway) 'Looping all lines in text file) Line Input #AEL_Highway, strLine: Let arrOut(RecardRow) = strLine ' Zeile lesen - as before but this time place in element of output array Next RecardRow ' ===== (Do Until EOF(AEL_Highway) 'Looping all lines in text file)=== Close AEL_Highway ' Datei schließen Rem 5) search for specific strings '5a) Bring in text or texts to be searched for, reduce multiple spaces to single spaces between if more than one given and, and split into array of those individual text strings https://powerspreadsheets.com/excel-vba-inputbox/ http://www.excelfox.com/forum/showthread.php/2227-VBA-Input-Pop-up-Boxes-Application-InputBox-Method-versus-VBA-InputBox-Function?p=10462#post10462 Dim strSrch As String ' Let strSrch = VBA.InputBox(prompt:="Type in all or part of text or texts to be searched for" & vbCrLf & "Seperate texts by at least one space", Title:="Input text to be searched for in text File lines", Default:="KB23 6872 35689", xpos:=100, ypos:=100) Let strSrch = Evaluate("=TRIM(SUBSTITUTE(" & """" & strSrch & """" & ",CHAR(32)," & """" & " " & """" & "))") ' TRIM function trims the 7-bit ASCII space character (value 32). In the Unicode character set, there is an additional space character called the nonbreaking space character that has a decimal value of 160. This character is commonly used in Web pages as the HTML entity,  . By itself, the TRIM function does not remove this nonbreaking space character. https://www.excelforum.com/excel-formulas-and-functions/1217202-is-there-a-function-similar-to-trim-but-that-only-removes-trailing-spaces-2.html Dim SrchTxts() As String ' VBA strings function split to be used to get individual text into elements of an Array. The split function returns an array of string type elements Let SrchTxts() = VBA.Split(strSrch, " ", -1, vbTextCompare) ' Split the ( strSrch , using space as delimiter , for unrestricted count , using text compare which is case insensitive ) For RecardRow = 2 To RecardRows 'At each record row Dim Txtie As Long ' in default example this is 0 1 2 For Txtie = 0 To UBound(SrchTxts()) ' VBA Split retuns a 1 dimension array starting at indicie 0 For example we have indicies of 0 1 2 givig three elements in total of KB23 6872 35689 Dim strFnded As String If InStr(1, arrOut(RecardRow), SrchTxts(Txtie), vbTextCompare) > 0 Then Let strFnded = strFnded & vbCrLf & arrOut(RecardRow) ' The returned postion along from the left ( starting from fist character , in the current row , looking for current text string , compare text which is case insensitive ) This will return 0 if not found and if found the postione along from the left in the row string where the search string part starts. So an found position will do for a find Next Txtie Next RecardRow Rem 6) Display search results Let strSrch = Replace(strSrch, " ", vbCrLf, 1, -1, vbBinaryCompare) 'replace in ( strSrch , space , with carriage return , start at and return from first character , no resriction on count , compare of exact computer memory so effectively case sensitive which is probably faster ) for convinent string list in output later MsgBox prompt:="You looked for" & vbCrLf & strSrch & vbCrLf & vbCrLf & "Finded was" & strFnded Debug.Print "You looked for" & vbCrLf & strSrch & vbCrLf & vbCrLf & "Finded was" & strFnded Exit Sub ' Normal code ending GetLaid: ' "Error handling code section http://www.excelfox.com/forum/showthread.php/2239-Resume-On-Error-GoTo-0-1-GoTo-Error-Handling-Statements-Runtime-VBA-Error-Handling-ORNeRe-GoRoT-N0Nula-1 MsgBox (Err.Description) Close AEL_Highway ' Datei scheißen End Sub

Some typical results in next post

Using this File:
“UpdatesOnVistaAspire4810TZG25thMarch.txt” : https://app.box.com/s/z90o8yj7iz0188yci34mu7gahe2tfhce
That file is downloaded into the same Folder as the file containing the code from the last Post.
This code line needs to have that text file reference in it such:
Let ActiviEL = ThisWorkbook.Path & "\UpdatesOnVistaAspire4810TZG25thMarch.txt"
Run code entering these search values when prompted
2553154 2726958 2965291 2920813 3054873 974554

Here the output string

You looked for
2553154
2726958
2965291
2920813
3054873
974554

Finded was

_.______________________________________________

Using this File:
“UpdatesAcerMartinWin7Pro64Bit26thMarch.txt” : https://app.box.com/s/8m96l0e7yh1wcb15y06eaaz6a7vtjzgd
That file is downloaded into the same Folder as the file containing the code from the last Post.
This code line needs to have that text file reference in it such:
Let ActiviEL = ThisWorkbook.Path & "\“UpdatesAcerMartinWin7Pro64Bit26thMarch.txt"
Run code entering these search values when prompted
2553154 2726958 2965291 2920813 3054873 974554

Here the output string

You looked for
2553154
2726958
2965291
2920813
3054873
974554

Finded was

5 Attachment(s)

Finding and deleteing .exd files

Appendix notes in support of these Threads:
http://www.excelfox.com/forum/showth...en-insert-them
http://www.excelfox.com/forum/showth...ommand-Buttons

Trying to find .exd files and delete them.
The results of most of what I have read or results of asking people suggests that they are usually findable if you look for a temp or temp somewhere in a file path

These appear a bit difficult to find sometimes . You can try:

_ manually navigating

_ a windows explorer search for *.exd
StarDotexeExplorerSearch.JPG : https://imgur.com/hfbC93Z
Attachment 2037

_ a search in a small bar using %temp% or %Temp%
You can get the small bar from either hitting WindowsKey+r or by selecting the Windows symbol
PerCenttempPerCentsearch.JPG : https://imgur.com/LypHLGY
Attachment 2038
PerCenttempPerCentsearch2.jpg : https://imgur.com/DZvycco
Attachment 2039

It seems a bit inconsistent which search finds what, but usually it is said that you find important places looking something like these:
C:\Users\username\AppData\Local\Temp\Excel8.0
C:\Users\username\AppData\Local\Temp\VBE

I found sometimes .exd files here also
C:\Users\username\Application Data\Microsoft\Forms

Some other typical places I found
C:\Dokumente und Einstellungen\Administrator\Application Data\Microsoft\Forms
C:\Dokumente und Einstellungen\Administrator\AppData\LocalLow

_.____._____________________

This is one of my typical attempts to get a ActiveX control button to_... either
_ insert into worksheet
or , if already three
_ work
_... by deleting .exd files

What I typically tried:
I looked here C:\Users\Elston\AppData\Local\Temp\Excel8.0
I found this:
C Users Elston AppData Local Temp Excel8.0.jpg https://imgur.com/doXstmr
Attachment 2040

I deleted that MSForms.exd File ( Excel had to be closed to do that ) : It had no effect. ( By the way, MSForms.exd gets made again every time I hit the button, or it appears to get made as soon as I open any file that either has or has ever had a control embedded in a worksheet)

In C:\Users\Elston\AppData\Local\Temp\VBE I found these:
C Users Elston AppData Local Temp VBE.jpg https://imgur.com/wjaZpXp
Attachment 2041

So…for these files I did:…
MSComctlLib.exd : I deleted this , - no effect
MSForms.exd : This could not be deleted with Excel 2003 open, it can when it is closed. But that had no effect
RefEdit.exd : This could not be deleted with Excel 2003 open, it can when it is closed. But no that had effect
( By the way, MSForms.exd and RefEdit.exd get made again every time I hit the button, or it appears to get made as soon as I open any file that either has, or has ever had, a control embedded in a worksheet )

In C:\Users\Elston\Application Data\Microsoft\Forms
I found these:
( https://imgur.com/Lv2kyhk )

So……for these files I did:…
RefEdit.exd This could not be deleted with Excel 2003 open, it can when it is closed. But that had no effect
mscomctllib.exd I deleted this: That had no effect
SHDocVw.exd I deleted this: That had no effect
( By the way, MSForms.exd gets made again every time I hit the button, or it appears to get made as soon as I open any file that either has or has ever had a control embedded in a worksheet)

_.._______________-

So for me none of that helped to get me a working ActiveX control Button in a worksheet.

:(

Screenshots and extra notes in support of this Thread:
http://www.excelfox.com/forum/showth...0595#post10595

Distributed Files for the day for "Raghu.xlsx"
From Raghu
Using Excel 2007 32 bit

_Row\^Col
A

B

C

D

E

F

G

H

I

J

K

L

M

N

1

S No

Item

Price

Qty

Total

Distributed

Task1

Task2

Task3

Task4

Completed

Consolidated

Comments

Team Member

2

1
ABC01
$ 55.00

22

$ 1,210.00

15. Mrz 18
Raghu

3

5
ABC05
$ 7.22

62

$ 447.64

15. Mrz 18
Raghu

4

9
ABC09
$ 741.99

101

$ 74,940.99

15. Mrz 18
Raghu

5

13
ABC13
$ 8.51

12

$ 102.12

15. Mrz 18
Raghu

6

17
ABC17
$ 11.99

1

$ 11.99

15. Mrz 18
Raghu

7

21
ABC21
$ 12.99

5

$ 64.95

15. Mrz 18
Raghu

8

25
ABC25
$ 333.45

99

$ 33,011.55

15. Mrz 18
Raghu

9

29
ABC29
$ 13.66

7

$ 95.62

15. Mrz 18
Raghu

10

33
ABC33
$ 3.99

35

$ 139.65

15. Mrz 18
Raghu

11

37
ABC37
$ 55.00

22

$ 1,210.00

15. Mrz 18
Raghu

12

41
ABC41
$ 7.22

62

$ 447.64

15. Mrz 18
Raghu

13

45
ABC45
$ 741.99

101

$ 74,940.99

15. Mrz 18
Raghu

Worksheet: FromRaghu

Or if distributed today, 2nd April
Using Excel 2007 32 bit

_Row\^Col
A

B

C

D

E

F

G

H

I

J

K

L

M

N

1

S No

Item

Price

Qty

Total

Distributed

Task1

Task2

Task3

Task4

Completed

Consolidated

Comments

Team Member

2

1
ABC01
$ 55.00

22

$ 1,210.00
02.Apr.2018 Raghu

3

5
ABC05
$ 7.22

62

$ 447.64
02.Apr.2018 Raghu

4

9
ABC09
$ 741.99

101

$ 74,940.99
02.Apr.2018 Raghu

5

13
ABC13
$ 8.51

12

$ 102.12
02.Apr.2018 Raghu

6

17
ABC17
$ 11.99

1

$ 11.99
02.Apr.2018 Raghu

7

21
ABC21
$ 12.99

5

$ 64.95
02.Apr.2018 Raghu

8

25
ABC25
$ 333.45

99

$ 33,011.55
02.Apr.2018 Raghu

9

29
ABC29
$ 13.66

7

$ 95.62
02.Apr.2018 Raghu

10

33
ABC33
$ 3.99

35

$ 139.65
02.Apr.2018 Raghu

11

37
ABC37
$ 55.00

22

$ 1,210.00
02.Apr.2018 Raghu

12

41
ABC41
$ 7.22

62

$ 447.64
02.Apr.2018 Raghu

13

45
ABC45
$ 741.99

101

$ 74,940.99
02.Apr.2018 Raghu

Worksheet: Tabelle1

_.________________________

In next Post could be a typical returned worksheet from a team member : ( based on similar files in the Zip Folder "WorkDistributedAndConsolidated 16MAR18.zip" )

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	S No	Item	Price	Qty	Total	Distributed	Task1	Task2	Task3	Task4	Completed	Consolidated	Comments	Team Member
2	1	ABC01	$ 55.00	22	$ 1,210.00	15. Mrz 18								Raghu
3	5	ABC05	$ 7.22	62	$ 447.64	15. Mrz 18								Raghu
4	9	ABC09	$ 741.99	101	$ 74,940.99	15. Mrz 18								Raghu
5	13	ABC13	$ 8.51	12	$ 102.12	15. Mrz 18								Raghu
6	17	ABC17	$ 11.99	1	$ 11.99	15. Mrz 18								Raghu
7	21	ABC21	$ 12.99	5	$ 64.95	15. Mrz 18								Raghu
8	25	ABC25	$ 333.45	99	$ 33,011.55	15. Mrz 18								Raghu
9	29	ABC29	$ 13.66	7	$ 95.62	15. Mrz 18								Raghu
10	33	ABC33	$ 3.99	35	$ 139.65	15. Mrz 18								Raghu
11	37	ABC37	$ 55.00	22	$ 1,210.00	15. Mrz 18								Raghu
12	41	ABC41	$ 7.22	62	$ 447.64	15. Mrz 18								Raghu
13	45	ABC45	$ 741.99	101	$ 74,940.99	15. Mrz 18								Raghu

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	S No	Item	Price	Qty	Total	Distributed	Task1	Task2	Task3	Task4	Completed	Consolidated	Comments	Team Member
2	1	ABC01	$ 55.00	22	$ 1,210.00	02.Apr.2018								Raghu
3	5	ABC05	$ 7.22	62	$ 447.64	02.Apr.2018								Raghu
4	9	ABC09	$ 741.99	101	$ 74,940.99	02.Apr.2018								Raghu
5	13	ABC13	$ 8.51	12	$ 102.12	02.Apr.2018								Raghu
6	17	ABC17	$ 11.99	1	$ 11.99	02.Apr.2018								Raghu
7	21	ABC21	$ 12.99	5	$ 64.95	02.Apr.2018								Raghu
8	25	ABC25	$ 333.45	99	$ 33,011.55	02.Apr.2018								Raghu
9	29	ABC29	$ 13.66	7	$ 95.62	02.Apr.2018								Raghu
10	33	ABC33	$ 3.99	35	$ 139.65	02.Apr.2018								Raghu
11	37	ABC37	$ 55.00	22	$ 1,210.00	02.Apr.2018								Raghu
12	41	ABC41	$ 7.22	62	$ 447.64	02.Apr.2018								Raghu
13	45	ABC45	$ 741.99	101	$ 74,940.99	02.Apr.2018								Raghu

From last post...

This could be a typical returned worksheet from a team member : ( based on similar files in the Zip Folder "WorkDistributedAndConsolidated 16MAR18.zip" )
Using Excel 2007 32 bit

_Row\^Col
A

B

C

D

E

F

G

H

I

J

K

L

M

N

1

S No

Item

Price

Qty

Total

Distributed

Task1

Task2

Task3

Task4

Completed

Consolidated

Comments

Team Member

2

1
ABC01
$ 55.00

22

$ 1,210.00

15. Mrz 18
RT1 RT2 RT3 RT4
02. Apr 18
Raghu

3

5
ABC05
$ 7.22

62

$ 447.64

15. Mrz 18
RT1 RT2 RT3 RT4
02. Apr 18
Raghu

4

9
ABC09
$ 741.99

101

$ 74,940.99

15. Mrz 18
RT1 RT2 RT3 RT4
02. Apr 18
Raghu

5

13
ABC13
$ 8.51

12

$ 102.12

15. Mrz 18
RT1 RT2 RT3 RT4
02. Apr 18
Raghu

6

17
ABC17
$ 11.99

1

$ 11.99

15. Mrz 18
RT1 RT2 RT3 RT4
02. Apr 18
Raghu

7

21
ABC21
$ 12.99

5

$ 64.95

15. Mrz 18
Raghu

8

25
ABC25
$ 333.45

99

$ 33,011.55

15. Mrz 18
Raghu

9

29
ABC29
$ 13.66

7

$ 95.62

15. Mrz 18
Raghu

10

33
ABC33
$ 3.99

35

$ 139.65

15. Mrz 18
Raghu

11

37
ABC37
$ 55.00

22

$ 1,210.00

15. Mrz 18
Raghu

12

41
ABC41
$ 7.22

62

$ 447.64

15. Mrz 18
Raghu

13

45
ABC45
$ 741.99

101

$ 74,940.99

15. Mrz 18
Raghu

Worksheet: FromRaghu

or this
Using Excel 2007 32 bit

_Row\^Col
A

B

C

D

E

F

G

H

I

J

K

L

M

N

1

S No

Item

Price

Qty

Total

Distributed

Task1

Task2

Task3

Task4

Completed

Consolidated

Comments

Team Member

2

1
ABC01
$ 55.00

22

$ 1,210.00
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

3

5
ABC05
$ 7.22

62

$ 447.64
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

4

9
ABC09
$ 741.99

101

$ 74,940.99
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

5

13
ABC13
$ 8.51

12

$ 102.12
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

6

17
ABC17
$ 11.99

1

$ 11.99
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

7

21
ABC21
$ 12.99

5

$ 64.95
02.Apr.2018 Raghu

8

25
ABC25
$ 333.45

99

$ 33,011.55
02.Apr.2018 Raghu

9

29
ABC29
$ 13.66

7

$ 95.62
02.Apr.2018 Raghu

10

33
ABC33
$ 3.99

35

$ 139.65
02.Apr.2018 Raghu

11

37
ABC37
$ 55.00

22

$ 1,210.00
02.Apr.2018 Raghu

12

41
ABC41
$ 7.22

62

$ 447.64
02.Apr.2018 Raghu

13

45
ABC45
$ 741.99

101

$ 74,940.99
02.Apr.2018 Raghu

Worksheet: Tabelle1

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	S No	Item	Price	Qty	Total	Distributed	Task1	Task2	Task3	Task4	Completed	Consolidated	Comments	Team Member
2	1	ABC01	$ 55.00	22	$ 1,210.00	15. Mrz 18	RT1	RT2	RT3	RT4	02. Apr 18			Raghu
3	5	ABC05	$ 7.22	62	$ 447.64	15. Mrz 18	RT1	RT2	RT3	RT4	02. Apr 18			Raghu
4	9	ABC09	$ 741.99	101	$ 74,940.99	15. Mrz 18	RT1	RT2	RT3	RT4	02. Apr 18			Raghu
5	13	ABC13	$ 8.51	12	$ 102.12	15. Mrz 18	RT1	RT2	RT3	RT4	02. Apr 18			Raghu
6	17	ABC17	$ 11.99	1	$ 11.99	15. Mrz 18	RT1	RT2	RT3	RT4	02. Apr 18			Raghu
7	21	ABC21	$ 12.99	5	$ 64.95	15. Mrz 18								Raghu
8	25	ABC25	$ 333.45	99	$ 33,011.55	15. Mrz 18								Raghu
9	29	ABC29	$ 13.66	7	$ 95.62	15. Mrz 18								Raghu
10	33	ABC33	$ 3.99	35	$ 139.65	15. Mrz 18								Raghu
11	37	ABC37	$ 55.00	22	$ 1,210.00	15. Mrz 18								Raghu
12	41	ABC41	$ 7.22	62	$ 447.64	15. Mrz 18								Raghu
13	45	ABC45	$ 741.99	101	$ 74,940.99	15. Mrz 18								Raghu

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	S No	Item	Price	Qty	Total	Distributed	Task1	Task2	Task3	Task4	Completed	Consolidated	Comments	Team Member
2	1	ABC01	$ 55.00	22	$ 1,210.00	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18			Raghu
3	5	ABC05	$ 7.22	62	$ 447.64	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18			Raghu
4	9	ABC09	$ 741.99	101	$ 74,940.99	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18			Raghu
5	13	ABC13	$ 8.51	12	$ 102.12	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18			Raghu
6	17	ABC17	$ 11.99	1	$ 11.99	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18			Raghu
7	21	ABC21	$ 12.99	5	$ 64.95	02.Apr.2018								Raghu
8	25	ABC25	$ 333.45	99	$ 33,011.55	02.Apr.2018								Raghu
9	29	ABC29	$ 13.66	7	$ 95.62	02.Apr.2018								Raghu
10	33	ABC33	$ 3.99	35	$ 139.65	02.Apr.2018								Raghu
11	37	ABC37	$ 55.00	22	$ 1,210.00	02.Apr.2018								Raghu
12	41	ABC41	$ 7.22	62	$ 447.64	02.Apr.2018								Raghu
13	45	ABC45	$ 741.99	101	$ 74,940.99	02.Apr.2018								Raghu

For this Post
http://www.excelfox.com/forum/showth...0595#post10595

Daily data files completed by team members:
John

S No

Item

Price

Qty

Total

Distributed

Task1

Task2

Task3

Task4

Completed

Consolidated

2
ABC02
$ 13.66

7

$ 95.62
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018

6
ABC06
$ 3.99

35

$ 139.65
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018

10
ABC10
$ 55.00

22

$ 1,210.00
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018

14
ABC14
$ 7.22

62

$ 447.64
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018

18
ABC18
$ 741.99

101

$ 74,940.99
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018

22
ABC22
$ 8.51

12

$ 102.12
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018

26
ABC26
$ 11.99

1

$ 11.99
02.Apr.2018

Worksheet: Tabelle1

Greg

3
ABC03
$ 12.99

5

$ 64.95
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018

7
ABC07
$ 333.45

99

$ 33,011.55
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018

11
ABC11
$ 13.66

7

$ 95.62
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018

15
ABC15
$ 3.99

35

$ 139.65
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018

19
ABC19
$ 55.00

22

$ 1,210.00
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018

23
ABC23
$ 7.22

62

$ 447.64
02.Apr.2018

Worksheet: Tabelle1

Margret

4
ABC04
$ 8.51

12

$ 102.12
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018

8
ABC08
$ 11.99

1

$ 11.99
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018

12
ABC12
$ 12.99

5

$ 64.95
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018

16
ABC16
$ 333.45

99

$ 33,011.55
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018

20
ABC20
$ 13.66

7

$ 95.62
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018

24
ABC24
$ 3.99

35

$ 139.65
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018

28
ABC28
$ 55.00

22

$ 1,210.00
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018

32
ABC32
$ 7.22

62

$ 447.64
02.Apr.2018

Worksheet: Tabelle1

Raghu

_Row\^Col
A

B

C

D

E

F

G

H

I

J

K

L

M

N

1

S No

Item

Price

Qty

Total

Distributed

Task1

Task2

Task3

Task4

Completed

Consolidated

Comments

Team Member

2

1
ABC01
$ 55.00

22

$ 1,210.00
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

3

5
ABC05
$ 7.22

62

$ 447.64
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

4

9
ABC09
$ 741.99

101

$ 74,940.99
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

5

13
ABC13
$ 8.51

12

$ 102.12
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

6

17
ABC17
$ 11.99

1

$ 11.99
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

7

21
ABC21
$ 12.99

5

$ 64.95
02.Apr.2018 Raghu

8

25
ABC25
$ 333.45

99

$ 33,011.55
02.Apr.2018 Raghu

Worksheet: Tabelle1

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	S No	Item	Price	Qty	Total	Distributed	Task1	Task2	Task3	Task4	Completed	Consolidated	Comments	Team Member
2	1	ABC01	$ 55.00	22	$ 1,210.00	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18			Raghu
3	5	ABC05	$ 7.22	62	$ 447.64	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18			Raghu
4	9	ABC09	$ 741.99	101	$ 74,940.99	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18			Raghu
5	13	ABC13	$ 8.51	12	$ 102.12	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18			Raghu
6	17	ABC17	$ 11.99	1	$ 11.99	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18			Raghu
7	21	ABC21	$ 12.99	5	$ 64.95	02.Apr.2018								Raghu
8	25	ABC25	$ 333.45	99	$ 33,011.55	02.Apr.2018								Raghu

From last Post... master File After Distribition and before Consolidation
File: “zMasterBeforeConsolidation.xlsm”
https://app.box.com/s/818q2ev3owpini2202n3dqp3xxicfeif

S No

Item

Price

Qty

Total

Distributed

Task1

Task2

Task3

Task4

Completed

Consolidated

Comments

Team Member

Checked

1
ABC01
$ 55.00

22

$ 1,210.00
02.Apr.2018 Raghu

2
ABC02
$ 13.66

7

$ 95.62
02.Apr.2018 John

3
ABC03
$ 12.99

5

$ 64.95
02.Apr.2018 Greg

4
ABC04
$ 8.51

12

$ 102.12
02.Apr.2018 Margaret

5
ABC05
$ 7.22

62

$ 447.64
02.Apr.2018 Raghu

6
ABC06
$ 3.99

35

$ 139.65
02.Apr.2018 John

7
ABC07
$ 333.45

99

$ 33,011.55
02.Apr.2018 Greg

8
ABC08
$ 11.99

1

$ 11.99
02.Apr.2018 Margaret

9
ABC09
$ 741.99

101

$ 74,940.99
02.Apr.2018 Raghu

10
ABC10
$ 55.00

22

$ 1,210.00
02.Apr.2018 John

11
ABC11
$ 13.66

7

$ 95.62
02.Apr.2018 Greg

12
ABC12
$ 12.99

5

$ 64.95
02.Apr.2018 Margaret

13
ABC13
$ 8.51

12

$ 102.12
02.Apr.2018 Raghu

14
ABC14
$ 7.22

62

$ 447.64
02.Apr.2018 John

15
ABC15
$ 3.99

35

$ 139.65
02.Apr.2018 Greg

16
ABC16
$ 333.45

99

$ 33,011.55
02.Apr.2018 Margaret

17
ABC17
$ 11.99

1

$ 11.99
02.Apr.2018 Raghu

18
ABC18
$ 741.99

101

$ 74,940.99
02.Apr.2018 John

19
ABC19
$ 55.00

22

$ 1,210.00
02.Apr.2018 Greg

20
ABC20
$ 13.66

7

$ 95.62
02.Apr.2018 Margaret

21
ABC21
$ 12.99

5

$ 64.95
02.Apr.2018 Raghu

22
ABC22
$ 8.51

12

$ 102.12
02.Apr.2018 John

23
ABC23
$ 7.22

62

$ 447.64
02.Apr.2018 Greg

24
ABC24
$ 3.99

35

$ 139.65
02.Apr.2018 Margaret

25
ABC25
$ 333.45

99

$ 33,011.55
02.Apr.2018 Raghu

26
ABC26
$ 11.99

1

$ 11.99
02.Apr.2018 John

27
ABC27
$ 741.99

101

$ 74,940.99
02.Apr.2018 Greg

28
ABC28
$ 55.00

22

$ 1,210.00
02.Apr.2018 Margaret

29
ABC29
$ 13.66

7

$ 95.62
02.Apr.2018 Raghu

30
ABC30
$ 12.99

5

$ 64.95
02.Apr.2018 John

31
ABC31
$ 8.51

12

$ 102.12
02.Apr.2018 Greg

32
ABC32
$ 7.22

62

$ 447.64
02.Apr.2018 Margaret

33
ABC33
$ 3.99

35

$ 139.65
02.Apr.2018 Raghu

34
ABC34
$ 333.45

99

$ 33,011.55
02.Apr.2018 John

35
ABC35
$ 11.99

1

$ 11.99
02.Apr.2018 Greg

36
ABC36
$ 741.99

101

$ 74,940.99
02.Apr.2018 Margaret

37
ABC37
$ 55.00

22

$ 1,210.00
02.Apr.2018 Raghu

38
ABC38
$ 13.66

7

$ 95.62
02.Apr.2018 John

39
ABC39
$ 12.99

5

$ 64.95
02.Apr.2018 Greg

40
ABC40
$ 8.51

12

$ 102.12
02.Apr.2018 Margaret

41
ABC41
$ 7.22

62

$ 447.64
02.Apr.2018 Raghu

42
ABC42
$ 3.99

35

$ 139.65
02.Apr.2018 John

43
ABC43
$ 333.45

99

$ 33,011.55
02.Apr.2018 Greg

44
ABC44
$ 11.99

1

$ 11.99
02.Apr.2018 Margaret

45
ABC45
$ 741.99

101

$ 74,940.99
02.Apr.2018 Raghu

Worksheet: OriginalData

Master File After First Consolidation

Using Excel 2007 32 bit

S No

Item

Price

Qty

Total

Distributed

Task1

Task2

Task3

Task4

Completed

Consolidated

Comments

Team Member

Checked

1
ABC01
$ 55.00

22

$ 1,210.00
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

2
ABC02
$ 13.66

7

$ 95.62
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

3
ABC03
$ 12.99

5

$ 64.95
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

4
ABC04
$ 8.51

12

$ 102.12
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

5
ABC05
$ 7.22

62

$ 447.64
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

6
ABC06
$ 3.99

35

$ 139.65
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

7
ABC07
$ 333.45

99

$ 33,011.55
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

8
ABC08
$ 11.99

1

$ 11.99
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

9
ABC09
$ 741.99

101

$ 74,940.99
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

10
ABC10
$ 55.00

22

$ 1,210.00
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

11
ABC11
$ 13.66

7

$ 95.62
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

12
ABC12
$ 12.99

5

$ 64.95
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

13
ABC13
$ 8.51

12

$ 102.12
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

14
ABC14
$ 7.22

62

$ 447.64
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

15
ABC15
$ 3.99

35

$ 139.65
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

16
ABC16
$ 333.45

99

$ 33,011.55
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

17
ABC17
$ 11.99

1

$ 11.99
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

18
ABC18
$ 741.99

101

$ 74,940.99
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

19
ABC19
$ 55.00

22

$ 1,210.00
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

20
ABC20
$ 13.66

7

$ 95.62
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

21
ABC21
$ 12.99

5

$ 64.95
02.Apr.2018 Raghu

22
ABC22
$ 8.51

12

$ 102.12
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

23
ABC23
$ 7.22

62

$ 447.64
02.Apr.2018 Greg

24
ABC24
$ 3.99

35

$ 139.65
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

25
ABC25
$ 333.45

99

$ 33,011.55
02.Apr.2018 Raghu

26
ABC26
$ 11.99

1

$ 11.99
02.Apr.2018 John

27
ABC27
$ 741.99

101

$ 74,940.99
02.Apr.2018 Greg

28
ABC28
$ 55.00

22

$ 1,210.00
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

29
ABC29
$ 13.66

7

$ 95.62
02.Apr.2018 Raghu

30
ABC30
$ 12.99

5

$ 64.95
02.Apr.2018 John

31
ABC31
$ 8.51

12

$ 102.12
02.Apr.2018 Greg

32
ABC32
$ 7.22

62

$ 447.64
02.Apr.2018 Margaret

33
ABC33
$ 3.99

35

$ 139.65
02.Apr.2018 Raghu

34
ABC34
$ 333.45

99

$ 33,011.55
02.Apr.2018 John

35
ABC35
$ 11.99

1

$ 11.99
02.Apr.2018 Greg

36
ABC36
$ 741.99

101

$ 74,940.99
02.Apr.2018 Margaret

37
ABC37
$ 55.00

22

$ 1,210.00
02.Apr.2018 Raghu

38
ABC38
$ 13.66

7

$ 95.62
02.Apr.2018 John

39
ABC39
$ 12.99

5

$ 64.95
02.Apr.2018 Greg

40
ABC40
$ 8.51

12

$ 102.12
02.Apr.2018 Margaret

41
ABC41
$ 7.22

62

$ 447.64
02.Apr.2018 Raghu

42
ABC42
$ 3.99

35

$ 139.65
02.Apr.2018 John

43
ABC43
$ 333.45

99

$ 33,011.55
02.Apr.2018 Greg

44
ABC44
$ 11.99

1

$ 11.99
02.Apr.2018 Margaret

45
ABC45
$ 741.99

101

$ 74,940.99
02.Apr.2018 Raghu

Worksheet: OriginalData

Some similar results to the last from previous post
These are from a File supplied by Raghu

S No

Item

Price

Qty

Total

Distributed

Task1

Task2

Task3

Task4

Completed

Consolidated

Comments

Team Member

1
ABC01
$ 55.00

22

$ 1,210.00

15. Mrz 18
RT1 RT2 RT3 RT4
16. Mrz 18

16. Mrz 18
Raghu

2
ABC02
$ 13.66

7

$ 95.62

15. Mrz 18
JT1 JT2 JT3 JT4
15. Mrz 18

16. Mrz 18
John

3
ABC03
$ 12.99

5

$ 64.95

15. Mrz 18
GT1 GT2 GT3 GT4
16. Mrz 18

16. Mrz 18
Greg

4
ABC04
$ 8.51

12

$ 102.12

15. Mrz 18
MT1 MT2 MT3 MT4
16. Mrz 18

16. Mrz 18
Margaret

5
ABC05
$ 7.22

62

$ 447.64

15. Mrz 18
RT1 RT2 RT3 RT4
16. Mrz 18

16. Mrz 18
Raghu

6
ABC06
$ 3.99

35

$ 139.65

15. Mrz 18
JT1 JT2 JT3 JT4
15. Mrz 18

16. Mrz 18
John

7
ABC07
$ 333.45

99

$ 33,011.55

15. Mrz 18
GT1 GT2 GT3 GT4
16. Mrz 18

16. Mrz 18
Greg

8
ABC08
$ 11.99

1

$ 11.99

15. Mrz 18
MT1 MT2 MT3 MT4
16. Mrz 18

16. Mrz 18
Margaret

9
ABC09
$ 741.99

101

$ 74,940.99

15. Mrz 18
RT1 RT2 RT3 RT4
16. Mrz 18

16. Mrz 18
Raghu

10
ABC10
$ 55.00

22

$ 1,210.00

15. Mrz 18
JT1 JT2 JT3 JT4
15. Mrz 18

16. Mrz 18
John

11
ABC11
$ 13.66

7

$ 95.62

15. Mrz 18
GT1 GT2 GT3 GT4
16. Mrz 18

16. Mrz 18
Greg

12
ABC12
$ 12.99

5

$ 64.95

15. Mrz 18
MT1 MT2 MT3 MT4
16. Mrz 18

16. Mrz 18
Margaret

13
ABC13
$ 8.51

12

$ 102.12

15. Mrz 18
RT1 RT2 RT3 RT4
16. Mrz 18

16. Mrz 18
Raghu

14
ABC14
$ 7.22

62

$ 447.64

15. Mrz 18
JT1 JT2 JT3 JT4
15. Mrz 18

16. Mrz 18
John

15
ABC15
$ 3.99

35

$ 139.65

15. Mrz 18
GT1 GT2 GT3 GT4
16. Mrz 18

16. Mrz 18
Greg

16
ABC16
$ 333.45

99

$ 33,011.55

15. Mrz 18
MT1 MT2 MT3 MT4
16. Mrz 18

16. Mrz 18
Margaret

17
ABC17
$ 11.99

1

$ 11.99

15. Mrz 18
RT1 RT2 RT3 RT4
16. Mrz 18

16. Mrz 18
Raghu

18
ABC18
$ 741.99

101

$ 74,940.99

15. Mrz 18
JT1 JT2 JT3 JT4
16. Mrz 18

16. Mrz 18
John

19
ABC19
$ 55.00

22

$ 1,210.00

15. Mrz 18
GT1 GT2 GT3 GT4
16. Mrz 18

16. Mrz 18
Greg

20
ABC20
$ 13.66

7

$ 95.62

15. Mrz 18
MT1 MT2 MT3 MT4
16. Mrz 18

16. Mrz 18
Margaret

21
ABC21
$ 12.99

5

$ 64.95

15. Mrz 18
Raghu

22
ABC22
$ 8.51

12

$ 102.12

15. Mrz 18
JT1 JT2 JT3 JT4
16. Mrz 18

16. Mrz 18
John

23
ABC23
$ 7.22

62

$ 447.64

15. Mrz 18
Greg

24
ABC24
$ 3.99

35

$ 139.65

15. Mrz 18
MT1 MT2 MT3 MT4
16. Mrz 18

16. Mrz 18
Margaret

25
ABC25
$ 333.45

99

$ 33,011.55

15. Mrz 18
Raghu

26
ABC26
$ 11.99

1

$ 11.99

15. Mrz 18
John

27
ABC27
$ 741.99

101

$ 74,940.99

15. Mrz 18
Greg

28
ABC28
$ 55.00

22

$ 1,210.00

15. Mrz 18
MT1 MT2 MT3 MT4
16. Mrz 18

16. Mrz 18
Margaret

29
ABC29
$ 13.66

7

$ 95.62

15. Mrz 18
Raghu

30
ABC30
$ 12.99

5

$ 64.95

15. Mrz 18
John

31
ABC31
$ 8.51

12

$ 102.12

15. Mrz 18
Greg

32
ABC32
$ 7.22

62

$ 447.64

15. Mrz 18
Margaret

33
ABC33
$ 3.99

35

$ 139.65

15. Mrz 18
Raghu

34
ABC34
$ 333.45

99

$ 33,011.55

15. Mrz 18
John

Worksheet: OriginalData

Bottom part of worksheet shown in last Post
here we see new data added ( rows 47 to 51 ( S No 46 - S no 50 )

Using Excel 2007 32 bit

16
ABC16
$ 333.45

99

$ 33,011.55

15. Mrz 18
MT1 MT2 MT3 MT4
16. Mrz 18

16. Mrz 18
Margaret

17
ABC17
$ 11.99

1

$ 11.99

15. Mrz 18
RT1 RT2 RT3 RT4
16. Mrz 18

16. Mrz 18
Raghu

18
ABC18
$ 741.99

101

$ 74,940.99

15. Mrz 18
JT1 JT2 JT3 JT4
16. Mrz 18

16. Mrz 18
John

19
ABC19
$ 55.00

22

$ 1,210.00

15. Mrz 18
GT1 GT2 GT3 GT4
16. Mrz 18

16. Mrz 18
Greg

20
ABC20
$ 13.66

7

$ 95.62

15. Mrz 18
MT1 MT2 MT3 MT4
16. Mrz 18

16. Mrz 18
Margaret

21
ABC21
$ 12.99

5

$ 64.95

15. Mrz 18
Raghu

22
ABC22
$ 8.51

12

$ 102.12

15. Mrz 18
JT1 JT2 JT3 JT4
16. Mrz 18

16. Mrz 18
John

23
ABC23
$ 7.22

62

$ 447.64

15. Mrz 18
Greg

24
ABC24
$ 3.99

35

$ 139.65

15. Mrz 18
MT1 MT2 MT3 MT4
16. Mrz 18

16. Mrz 18
Margaret

25
ABC25
$ 333.45

99

$ 33,011.55

15. Mrz 18
Raghu

26
ABC26
$ 11.99

1

$ 11.99

15. Mrz 18
John

27
ABC27
$ 741.99

101

$ 74,940.99

15. Mrz 18
Greg

28
ABC28
$ 55.00

22

$ 1,210.00

15. Mrz 18
MT1 MT2 MT3 MT4
16. Mrz 18

16. Mrz 18
Margaret

29
ABC29
$ 13.66

7

$ 95.62

15. Mrz 18
Raghu

30
ABC30
$ 12.99

5

$ 64.95

15. Mrz 18
John

31
ABC31
$ 8.51

12

$ 102.12

15. Mrz 18
Greg

32
ABC32
$ 7.22

62

$ 447.64

15. Mrz 18
Margaret

33
ABC33
$ 3.99

35

$ 139.65

15. Mrz 18
Raghu

34
ABC34
$ 333.45

99

$ 33,011.55

15. Mrz 18
John

35
ABC35
$ 11.99

1

$ 11.99

15. Mrz 18
Greg

36
ABC36
$ 741.99

101

$ 74,940.99

15. Mrz 18
Margaret

37
ABC37
$ 55.00

22

$ 1,210.00

15. Mrz 18
Raghu

38
ABC38
$ 13.66

7

$ 95.62

15. Mrz 18
John

39
ABC39
$ 12.99

5

$ 64.95

15. Mrz 18
Greg

40
ABC40
$ 8.51

12

$ 102.12

15. Mrz 18
Margaret

41
ABC41
$ 7.22

62

$ 447.64

15. Mrz 18
Raghu

42
ABC42
$ 3.99

35

$ 139.65

15. Mrz 18
John

43
ABC43
$ 333.45

99

$ 33,011.55

15. Mrz 18
Greg

44
ABC44
$ 11.99

1

$ 11.99

15. Mrz 18
Margaret

45
ABC45
$ 741.99

101

$ 74,940.99

15. Mrz 18
Raghu

46
ABC46
$ 8.51

12

$ 102.12

16. Mrz 18
John

47
ABC47
$ 7.22

62

$ 447.64

16. Mrz 18
Greg

48
ABC48
$ 3.99

35

$ 139.65

16. Mrz 18
Margaret

49
ABC49
$ 333.45

99

$ 33,011.55

16. Mrz 18
Raghu

50
ABC50
$ 11.99

1

$ 11.99

16. Mrz 18
Raghu

Worksheet: OriginalData

Typical Updated Data File, "Raghu.xlsx" after first consolidation

Typical Updated Data File, "Raghu.xlsx" after first consolidation,
with the column L updated appropriately with the consolidation date

Using Excel 2007 32 bit

_Row\^Col
A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

1

S No

Item

Price

Qty

Total

Distributed

Task1

Task2

Task3

Task4

Completed

Consolidated

Comments

Team Member

2

1
ABC01
$ 55.00

22

$ 1,210.00
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
02.Apr.2018 Raghu

3

5
ABC05
$ 7.22

62

$ 447.64
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
02.Apr.2018 Raghu

4

9
ABC09
$ 741.99

101

$ 74,940.99
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
02.Apr.2018 Raghu

5

13
ABC13
$ 8.51

12

$ 102.12
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
02.Apr.2018 Raghu

6

17
ABC17
$ 11.99

1

$ 11.99
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
02.Apr.2018 Raghu

7

21
ABC21
$ 12.99

5

$ 64.95
02.Apr.2018 Raghu

8

25
ABC25
$ 333.45

99

$ 33,011.55
02.Apr.2018 Raghu

9

29
ABC29
$ 13.66

7

$ 95.62
02.Apr.2018 Raghu

10

33
ABC33
$ 3.99

35

$ 139.65
02.Apr.2018 Raghu

11

37
ABC37
$ 55.00

22

$ 1,210.00
02.Apr.2018 Raghu

12

41
ABC41
$ 7.22

62

$ 447.64
02.Apr.2018 Raghu

13

45
ABC45
$ 741.99

101

$ 74,940.99
02.Apr.2018 Raghu

14

Worksheet: Tabelle1

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	S No	Item	Price	Qty	Total	Distributed	Task1	Task2	Task3	Task4	Completed	Consolidated	Comments	Team Member
2	1	ABC01	$ 55.00	22	$ 1,210.00	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18	02.Apr.2018		Raghu
3	5	ABC05	$ 7.22	62	$ 447.64	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18	02.Apr.2018		Raghu
4	9	ABC09	$ 741.99	101	$ 74,940.99	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18	02.Apr.2018		Raghu
5	13	ABC13	$ 8.51	12	$ 102.12	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18	02.Apr.2018		Raghu
6	17	ABC17	$ 11.99	1	$ 11.99	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18	02.Apr.2018		Raghu
7	21	ABC21	$ 12.99	5	$ 64.95	02.Apr.2018								Raghu
8	25	ABC25	$ 333.45	99	$ 33,011.55	02.Apr.2018								Raghu
9	29	ABC29	$ 13.66	7	$ 95.62	02.Apr.2018								Raghu
10	33	ABC33	$ 3.99	35	$ 139.65	02.Apr.2018								Raghu
11	37	ABC37	$ 55.00	22	$ 1,210.00	02.Apr.2018								Raghu
12	41	ABC41	$ 7.22	62	$ 447.64	02.Apr.2018								Raghu
13	45	ABC45	$ 741.99	101	$ 74,940.99	02.Apr.2018								Raghu
14

“zMasterAfter1stConsolidationNewData.xlsm” : https://app.box.com/s/ascky2qg47dzl85b4y7l8sy5qmr3goby

Using Excel 2007 32 bit

_Row\^Col
A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

19

18
ABC18
$ 741.99

101

$ 74,940.99
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

20

19
ABC19
$ 55.00

22

$ 1,210.00
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

21

20
ABC20
$ 13.66

7

$ 95.62
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

22

21
ABC21
$ 12.99

5

$ 64.95
02.Apr.2018 Raghu

23

22
ABC22
$ 8.51

12

$ 102.12
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

24

23
ABC23
$ 7.22

62

$ 447.64
02.Apr.2018 Greg

25

24
ABC24
$ 3.99

35

$ 139.65
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

26

25
ABC25
$ 333.45

99

$ 33,011.55
02.Apr.2018 Raghu

27

26
ABC26
$ 11.99

1

$ 11.99
02.Apr.2018 John

28

27
ABC27
$ 741.99

101

$ 74,940.99
02.Apr.2018 Greg

29

28
ABC28
$ 55.00

22

$ 1,210.00
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

30

29
ABC29
$ 13.66

7

$ 95.62
02.Apr.2018 Raghu

31

30
ABC30
$ 12.99

5

$ 64.95
02.Apr.2018 John

32

31
ABC31
$ 8.51

12

$ 102.12
02.Apr.2018 Greg

33

32
ABC32
$ 7.22

62

$ 447.64
02.Apr.2018 Margaret

34

33
ABC33
$ 3.99

35

$ 139.65
02.Apr.2018 Raghu

35

34
ABC34
$ 333.45

99

$ 33,011.55
02.Apr.2018 John

36

35
ABC35
$ 11.99

1

$ 11.99
02.Apr.2018 Greg

37

36
ABC36
$ 741.99

101

$ 74,940.99
02.Apr.2018 Margaret

38

37
ABC37
$ 55.00

22

$ 1,210.00
02.Apr.2018 Raghu

39

38
ABC38
$ 13.66

7

$ 95.62
02.Apr.2018 John

40

39
ABC39
$ 12.99

5

$ 64.95
02.Apr.2018 Greg

41

40
ABC40
$ 8.51

12

$ 102.12
02.Apr.2018 Margaret

42

41
ABC41
$ 7.22

62

$ 447.64
02.Apr.2018 Raghu

43

42
ABC42
$ 3.99

35

$ 139.65
02.Apr.2018 John

44

43
ABC43
$ 333.45

99

$ 33,011.55
02.Apr.2018 Greg

45

44
ABC44
$ 11.99

1

$ 11.99
02.Apr.2018 Margaret

46

45
ABC45
$ 741.99

101

$ 74,940.99
02.Apr.2018 Raghu

47

46
ABC46
$ 8.51

12

$ 102.12
John

48

47
ABC47
$ 7.22

62

$ 447.64
Greg

49

48
ABC48
$ 3.99

35

$ 139.65
Margaret

50

49
ABC49
$ 333.45

99

$ 33,011.55
Raghu

51

50
ABC50
$ 11.99

1

$ 11.99
Raghu

52

Worksheet: OriginalData

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K	L	N
19	18	ABC18	$ 741.99	101	$ 74,940.99	02.Apr.2018	JT1	JT2	JT3	JT4	02.Apr.2018	02.Apr.2018	John
20	19	ABC19	$ 55.00	22	$ 1,210.00	02.Apr.2018	GT1	GT2	GT3	GT4	02.Apr.2018	02.Apr.2018	Greg
21	20	ABC20	$ 13.66	7	$ 95.62	02.Apr.2018	MT1	MT2	MT3	MT4	02.Apr.2018	02.Apr.2018	Margaret
22	21	ABC21	$ 12.99	5	$ 64.95	02.Apr.2018							Raghu
23	22	ABC22	$ 8.51	12	$ 102.12	02.Apr.2018	JT1	JT2	JT3	JT4	02.Apr.2018	02.Apr.2018	John
24	23	ABC23	$ 7.22	62	$ 447.64	02.Apr.2018							Greg
25	24	ABC24	$ 3.99	35	$ 139.65	02.Apr.2018	MT1	MT2	MT3	MT4	02.Apr.2018	02.Apr.2018	Margaret
26	25	ABC25	$ 333.45	99	$ 33,011.55	02.Apr.2018							Raghu
27	26	ABC26	$ 11.99	1	$ 11.99	02.Apr.2018							John
28	27	ABC27	$ 741.99	101	$ 74,940.99	02.Apr.2018							Greg
29	28	ABC28	$ 55.00	22	$ 1,210.00	02.Apr.2018	MT1	MT2	MT3	MT4	02.Apr.2018	02.Apr.2018	Margaret
30	29	ABC29	$ 13.66	7	$ 95.62	02.Apr.2018							Raghu
31	30	ABC30	$ 12.99	5	$ 64.95	02.Apr.2018							John
32	31	ABC31	$ 8.51	12	$ 102.12	02.Apr.2018							Greg
33	32	ABC32	$ 7.22	62	$ 447.64	02.Apr.2018							Margaret
34	33	ABC33	$ 3.99	35	$ 139.65	02.Apr.2018							Raghu
35	34	ABC34	$ 333.45	99	$ 33,011.55	02.Apr.2018							John
36	35	ABC35	$ 11.99	1	$ 11.99	02.Apr.2018							Greg
37	36	ABC36	$ 741.99	101	$ 74,940.99	02.Apr.2018							Margaret
38	37	ABC37	$ 55.00	22	$ 1,210.00	02.Apr.2018							Raghu
39	38	ABC38	$ 13.66	7	$ 95.62	02.Apr.2018							John
40	39	ABC39	$ 12.99	5	$ 64.95	02.Apr.2018							Greg
41	40	ABC40	$ 8.51	12	$ 102.12	02.Apr.2018							Margaret
42	41	ABC41	$ 7.22	62	$ 447.64	02.Apr.2018							Raghu
43	42	ABC42	$ 3.99	35	$ 139.65	02.Apr.2018							John
44	43	ABC43	$ 333.45	99	$ 33,011.55	02.Apr.2018							Greg
45	44	ABC44	$ 11.99	1	$ 11.99	02.Apr.2018							Margaret
46	45	ABC45	$ 741.99	101	$ 74,940.99	02.Apr.2018							Raghu
47	46	ABC46	$ 8.51	12	$ 102.12								John
48	47	ABC47	$ 7.22	62	$ 447.64								Greg
49	48	ABC48	$ 3.99	35	$ 139.65								Margaret
50	49	ABC49	$ 333.45	99	$ 33,011.55								Raghu
51	50	ABC50	$ 11.99	1	$ 11.99								Raghu
52

Run Code Sub ExportByName() on data from last post

Results for Updated master Worksheet

Using Excel 2007 32 bit

_Row\^Col
A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

25

24
ABC24
$ 3.99

35

$ 139.65
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

26

25
ABC25
$ 333.45

99

$ 33,011.55
02.Apr.2018 Raghu

27

26
ABC26
$ 11.99

1

$ 11.99
02.Apr.2018 John

28

27
ABC27
$ 741.99

101

$ 74,940.99
02.Apr.2018 Greg

29

28
ABC28
$ 55.00

22

$ 1,210.00
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

30

29
ABC29
$ 13.66

7

$ 95.62
02.Apr.2018 Raghu

31

30
ABC30
$ 12.99

5

$ 64.95
02.Apr.2018 John

32

31
ABC31
$ 8.51

12

$ 102.12
02.Apr.2018 Greg

33

32
ABC32
$ 7.22

62

$ 447.64
02.Apr.2018 Margaret

34

33
ABC33
$ 3.99

35

$ 139.65
02.Apr.2018 Raghu

35

34
ABC34
$ 333.45

99

$ 33,011.55
02.Apr.2018 John

36

35
ABC35
$ 11.99

1

$ 11.99
02.Apr.2018 Greg

37

36
ABC36
$ 741.99

101

$ 74,940.99
02.Apr.2018 Margaret

38

37
ABC37
$ 55.00

22

$ 1,210.00
02.Apr.2018 Raghu

39

38
ABC38
$ 13.66

7

$ 95.62
02.Apr.2018 John

40

39
ABC39
$ 12.99

5

$ 64.95
02.Apr.2018 Greg

41

40
ABC40
$ 8.51

12

$ 102.12
02.Apr.2018 Margaret

42

41
ABC41
$ 7.22

62

$ 447.64
02.Apr.2018 Raghu

43

42
ABC42
$ 3.99

35

$ 139.65
02.Apr.2018 John

44

43
ABC43
$ 333.45

99

$ 33,011.55
02.Apr.2018 Greg

45

44
ABC44
$ 11.99

1

$ 11.99
02.Apr.2018 Margaret

46

45
ABC45
$ 741.99

101

$ 74,940.99
02.Apr.2018 Raghu

47

46
ABC46
$ 8.51

12

$ 102.12

02.Apr.2018
John

48

47
ABC47
$ 7.22

62

$ 447.64

02.Apr.2018
Greg

49

48
ABC48
$ 3.99

35

$ 139.65

02.Apr.2018
Margaret

50

49
ABC49
$ 333.45

99

$ 33,011.55

02.Apr.2018
Raghu

51

50
ABC50
$ 11.99

1

$ 11.99

02.Apr.2018
Raghu

52

53

54

Worksheet: OriginalData

Corresponding updated data worksheets for updated master after running Sub ExportByName() for the second time after new data was added

Using Excel 2007 32 bit

41
ABC41
$ 7.22

62

$ 447.64
02.Apr.2018 Raghu

45
ABC45
$ 741.99

101

$ 74,940.99
02.Apr.2018 Raghu

49
ABC49 $ 333.45
99
$ 33,011.55 02.Apr.2018 Raghu

50
ABC50 $ 11.99
1
$ 11.99 02.Apr.2018 Raghu

Worksheet: Tabelle1

Using Excel 2007 32 bit

40
ABC40
$ 8.51

12

$ 102.12
02.Apr.2018 Margaret

44
ABC44
$ 11.99

1

$ 11.99
02.Apr.2018 Margaret

48
ABC48 $ 3.99
35
$ 139.65 02.Apr.2018 Margaret

Worksheet: Tabelle1

Using Excel 2007 32 bit

38
ABC38
$ 13.66

7

$ 95.62
02.Apr.2018 John

42
ABC42
$ 3.99

35

$ 139.65
02.Apr.2018 John

46
ABC46 $ 8.51
12
$ 102.12 02.Apr.2018 John

Worksheet: Tabelle1

Using Excel 2007 32 bit

39
ABC39
$ 12.99

5

$ 64.95
02.Apr.2018 Greg

43
ABC43
$ 333.45

99

$ 33,011.55
02.Apr.2018 Greg

47
ABC47 $ 7.22
62
$ 447.64 02.Apr.2018 Greg

Worksheet: Tabelle1

Data Files just before second consolidation

15
ABC15
$ 3.99

35

$ 139.65
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

19
ABC19
$ 55.00

22

$ 1,210.00
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

23
ABC23
$ 7.22

62

$ 447.64
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 Greg

27
ABC27
$ 741.99

101

$ 74,940.99
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 Greg

31
ABC31
$ 8.51

12

$ 102.12
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 Greg

35
ABC35
$ 11.99

1

$ 11.99
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 Greg

39
ABC39
$ 12.99

5

$ 64.95
02.Apr.2018 Greg

Worksheet: Tabelle1

18
ABC18
$ 741.99

101

$ 74,940.99
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

22
ABC22
$ 8.51

12

$ 102.12
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

26
ABC26
$ 11.99

1

$ 11.99
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 John

30
ABC30
$ 12.99

5

$ 64.95
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 John

34
ABC34
$ 333.45

99

$ 33,011.55
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 John

38
ABC38
$ 13.66

7

$ 95.62
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 John

42
ABC42
$ 3.99

35

$ 139.65
02.Apr.2018 John

Worksheet: Tabelle1

28
ABC28
$ 55.00

22

$ 1,210.00
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

32
ABC32
$ 7.22

62

$ 447.64
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 Margaret

36
ABC36
$ 741.99

101

$ 74,940.99
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 Margaret

40
ABC40
$ 8.51

12

$ 102.12
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 Margaret

44
ABC44
$ 11.99

1

$ 11.99
02.Apr.2018 Margaret

Worksheet: Tabelle1

Using Excel 2007 32 bit

17
ABC17
$ 11.99

1

$ 11.99
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
02.Apr.2018 Raghu

21
ABC21
$ 12.99

5

$ 64.95
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

25
ABC25
$ 333.45

99

$ 33,011.55
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

29
ABC29
$ 13.66

7

$ 95.62
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

33
ABC33
$ 3.99

35

$ 139.65
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

37
ABC37
$ 55.00

22

$ 1,210.00
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

41
ABC41
$ 7.22

62

$ 447.64
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

45
ABC45
$ 741.99

101

$ 74,940.99
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

49
ABC49 $ 333.45
99
$ 33,011.55 02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
Raghu

50
ABC50 $ 11.99
1
$ 11.99 02.Apr.2018 Raghu

Worksheet: Tabelle1

Final results for first half of master File after second consolidation

Using Excel 2007 32 bit

_Row\^Col
A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

1

S No

Item

Price

Qty

Total

Distributed

Task1

Task2

Task3

Task4

Completed

Consolidated

Comments

Team Member

Checked

2

1
ABC01
$ 55.00

22

$ 1,210.00
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

3

2
ABC02
$ 13.66

7

$ 95.62
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

4

3
ABC03
$ 12.99

5

$ 64.95
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

5

4
ABC04
$ 8.51

12

$ 102.12
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

6

5
ABC05
$ 7.22

62

$ 447.64
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

7

6
ABC06
$ 3.99

35

$ 139.65
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

8

7
ABC07
$ 333.45

99

$ 33,011.55
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

9

8
ABC08
$ 11.99

1

$ 11.99
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

10

9
ABC09
$ 741.99

101

$ 74,940.99
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

11

10
ABC10
$ 55.00

22

$ 1,210.00
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

12

11
ABC11
$ 13.66

7

$ 95.62
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

13

12
ABC12
$ 12.99

5

$ 64.95
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

14

13
ABC13
$ 8.51

12

$ 102.12
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

15

14
ABC14
$ 7.22

62

$ 447.64
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

16

15
ABC15
$ 3.99

35

$ 139.65
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

17

16
ABC16
$ 333.45

99

$ 33,011.55
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

18

17
ABC17
$ 11.99

1

$ 11.99
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

19

18
ABC18
$ 741.99

101

$ 74,940.99
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

20

19
ABC19
$ 55.00

22

$ 1,210.00
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

21

20
ABC20
$ 13.66

7

$ 95.62
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

22

21
ABC21
$ 12.99

5

$ 64.95
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

23

22
ABC22
$ 8.51

12

$ 102.12
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

24

23
ABC23
$ 7.22

62

$ 447.64
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

25

24
ABC24
$ 3.99

35

$ 139.65
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

26

25
ABC25
$ 333.45

99

$ 33,011.55
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

Worksheet: OriginalData

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	S No	Item	Price	Qty	Total	Distributed	Task1	Task2	Task3	Task4	Completed	Consolidated	Comments	Team Member	Checked
2	1	ABC01	$ 55.00	22	$ 1,210.00	02.Apr.2018	RT1	RT2	RT3	RT4	02.04.2018	02.Apr.2018		Raghu
3	2	ABC02	$ 13.66	7	$ 95.62	02.Apr.2018	JT1	JT2	JT3	JT4	02.Apr.2018	02.Apr.2018		John
4	3	ABC03	$ 12.99	5	$ 64.95	02.Apr.2018	GT1	GT2	GT3	GT4	02.Apr.2018	02.Apr.2018		Greg
5	4	ABC04	$ 8.51	12	$ 102.12	02.Apr.2018	MT1	MT2	MT3	MT4	02.Apr.2018	02.Apr.2018		Margaret
6	5	ABC05	$ 7.22	62	$ 447.64	02.Apr.2018	RT1	RT2	RT3	RT4	02.04.2018	02.Apr.2018		Raghu
7	6	ABC06	$ 3.99	35	$ 139.65	02.Apr.2018	JT1	JT2	JT3	JT4	02.Apr.2018	02.Apr.2018		John
8	7	ABC07	$ 333.45	99	$ 33,011.55	02.Apr.2018	GT1	GT2	GT3	GT4	02.Apr.2018	02.Apr.2018		Greg
9	8	ABC08	$ 11.99	1	$ 11.99	02.Apr.2018	MT1	MT2	MT3	MT4	02.Apr.2018	02.Apr.2018		Margaret
10	9	ABC09	$ 741.99	101	$ 74,940.99	02.Apr.2018	RT1	RT2	RT3	RT4	02.04.2018	02.Apr.2018		Raghu
11	10	ABC10	$ 55.00	22	$ 1,210.00	02.Apr.2018	JT1	JT2	JT3	JT4	02.Apr.2018	02.Apr.2018		John
12	11	ABC11	$ 13.66	7	$ 95.62	02.Apr.2018	GT1	GT2	GT3	GT4	02.Apr.2018	02.Apr.2018		Greg
13	12	ABC12	$ 12.99	5	$ 64.95	02.Apr.2018	MT1	MT2	MT3	MT4	02.Apr.2018	02.Apr.2018		Margaret
14	13	ABC13	$ 8.51	12	$ 102.12	02.Apr.2018	RT1	RT2	RT3	RT4	02.04.2018	02.Apr.2018		Raghu
15	14	ABC14	$ 7.22	62	$ 447.64	02.Apr.2018	JT1	JT2	JT3	JT4	02.Apr.2018	02.Apr.2018		John
16	15	ABC15	$ 3.99	35	$ 139.65	02.Apr.2018	GT1	GT2	GT3	GT4	02.Apr.2018	02.Apr.2018		Greg
17	16	ABC16	$ 333.45	99	$ 33,011.55	02.Apr.2018	MT1	MT2	MT3	MT4	02.Apr.2018	02.Apr.2018		Margaret
18	17	ABC17	$ 11.99	1	$ 11.99	02.Apr.2018	RT1	RT2	RT3	RT4	02.04.2018	02.Apr.2018		Raghu
19	18	ABC18	$ 741.99	101	$ 74,940.99	02.Apr.2018	JT1	JT2	JT3	JT4	02.Apr.2018	02.Apr.2018		John
20	19	ABC19	$ 55.00	22	$ 1,210.00	02.Apr.2018	GT1	GT2	GT3	GT4	02.Apr.2018	02.Apr.2018		Greg
21	20	ABC20	$ 13.66	7	$ 95.62	02.Apr.2018	MT1	MT2	MT3	MT4	02.Apr.2018	02.Apr.2018		Margaret
22	21	ABC21	$ 12.99	5	$ 64.95	02.Apr.2018	RT1	RT2	RT3	RT4	02.04.2018	02.Apr.2018		Raghu
23	22	ABC22	$ 8.51	12	$ 102.12	02.Apr.2018	JT1	JT2	JT3	JT4	02.Apr.2018	02.Apr.2018		John
24	23	ABC23	$ 7.22	62	$ 447.64	02.Apr.2018	GT1	GT2	GT3	GT4	02.Apr.2018	02.Apr.2018		Greg
25	24	ABC24	$ 3.99	35	$ 139.65	02.Apr.2018	MT1	MT2	MT3	MT4	02.Apr.2018	02.Apr.2018		Margaret
26	25	ABC25	$ 333.45	99	$ 33,011.55	02.Apr.2018	RT1	RT2	RT3	RT4	02.04.2018	02.Apr.2018		Raghu

Second half of master worksheet after final second consolidation

Using Excel 2007 32 bit

_Row\^Col
A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

25

24
ABC24
$ 3.99

35

$ 139.65
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

26

25
ABC25
$ 333.45

99

$ 33,011.55
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

27

26
ABC26
$ 11.99

1

$ 11.99
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

28

27
ABC27
$ 741.99

101

$ 74,940.99
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

29

28
ABC28
$ 55.00

22

$ 1,210.00
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

30

29
ABC29
$ 13.66

7

$ 95.62
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

31

30
ABC30
$ 12.99

5

$ 64.95
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

32

31
ABC31
$ 8.51

12

$ 102.12
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

33

32
ABC32
$ 7.22

62

$ 447.64
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

34

33
ABC33
$ 3.99

35

$ 139.65
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

35

34
ABC34
$ 333.45

99

$ 33,011.55
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

36

35
ABC35
$ 11.99

1

$ 11.99
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

37

36
ABC36
$ 741.99

101

$ 74,940.99
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

38

37
ABC37
$ 55.00

22

$ 1,210.00
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

39

38
ABC38
$ 13.66

7

$ 95.62
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

40

39
ABC39
$ 12.99

5

$ 64.95
02.Apr.2018 Greg

41

40
ABC40
$ 8.51

12

$ 102.12
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

42

41
ABC41
$ 7.22

62

$ 447.64
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

43

42
ABC42
$ 3.99

35

$ 139.65
02.Apr.2018 John

44

43
ABC43
$ 333.45

99

$ 33,011.55
02.Apr.2018 Greg

45

44
ABC44
$ 11.99

1

$ 11.99
02.Apr.2018 Margaret

46

45
ABC45
$ 741.99

101

$ 74,940.99
02.Apr.2018 RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

47

46
ABC46
$ 8.51

12

$ 102.12

02.Apr.2018
John

48

47
ABC47
$ 7.22

62

$ 447.64

02.Apr.2018
Greg

49

48
ABC48
$ 3.99

35

$ 139.65

02.Apr.2018
Margaret

50

49
ABC49
$ 333.45

99

$ 33,011.55

02.Apr.2018
RT1 RT2 RT3 RT4 02.04.2018 02.Apr.2018 Raghu

51

50
ABC50
$ 11.99

1

$ 11.99

02.Apr.2018
Raghu

52

Worksheet: OriginalData

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K	L	N
25	24	ABC24	$ 3.99	35	$ 139.65	02.Apr.2018	MT1	MT2	MT3	MT4	02.Apr.2018	02.Apr.2018	Margaret
26	25	ABC25	$ 333.45	99	$ 33,011.55	02.Apr.2018	RT1	RT2	RT3	RT4	02.04.2018	02.Apr.2018	Raghu
27	26	ABC26	$ 11.99	1	$ 11.99	02.Apr.2018	JT1	JT2	JT3	JT4	02.Apr.2018	02.Apr.2018	John
28	27	ABC27	$ 741.99	101	$ 74,940.99	02.Apr.2018	GT1	GT2	GT3	GT4	02.Apr.2018	02.Apr.2018	Greg
29	28	ABC28	$ 55.00	22	$ 1,210.00	02.Apr.2018	MT1	MT2	MT3	MT4	02.Apr.2018	02.Apr.2018	Margaret
30	29	ABC29	$ 13.66	7	$ 95.62	02.Apr.2018	RT1	RT2	RT3	RT4	02.04.2018	02.Apr.2018	Raghu
31	30	ABC30	$ 12.99	5	$ 64.95	02.Apr.2018	JT1	JT2	JT3	JT4	02.Apr.2018	02.Apr.2018	John
32	31	ABC31	$ 8.51	12	$ 102.12	02.Apr.2018	GT1	GT2	GT3	GT4	02.Apr.2018	02.Apr.2018	Greg
33	32	ABC32	$ 7.22	62	$ 447.64	02.Apr.2018	MT1	MT2	MT3	MT4	02.Apr.2018	02.Apr.2018	Margaret
34	33	ABC33	$ 3.99	35	$ 139.65	02.Apr.2018	RT1	RT2	RT3	RT4	02.04.2018	02.Apr.2018	Raghu
35	34	ABC34	$ 333.45	99	$ 33,011.55	02.Apr.2018	JT1	JT2	JT3	JT4	02.Apr.2018	02.Apr.2018	John
36	35	ABC35	$ 11.99	1	$ 11.99	02.Apr.2018	GT1	GT2	GT3	GT4	02.Apr.2018	02.Apr.2018	Greg
37	36	ABC36	$ 741.99	101	$ 74,940.99	02.Apr.2018	MT1	MT2	MT3	MT4	02.Apr.2018	02.Apr.2018	Margaret
38	37	ABC37	$ 55.00	22	$ 1,210.00	02.Apr.2018	RT1	RT2	RT3	RT4	02.04.2018	02.Apr.2018	Raghu
39	38	ABC38	$ 13.66	7	$ 95.62	02.Apr.2018	JT1	JT2	JT3	JT4	02.Apr.2018	02.Apr.2018	John
40	39	ABC39	$ 12.99	5	$ 64.95	02.Apr.2018							Greg
41	40	ABC40	$ 8.51	12	$ 102.12	02.Apr.2018	MT1	MT2	MT3	MT4	02.Apr.2018	02.Apr.2018	Margaret
42	41	ABC41	$ 7.22	62	$ 447.64	02.Apr.2018	RT1	RT2	RT3	RT4	02.04.2018	02.Apr.2018	Raghu
43	42	ABC42	$ 3.99	35	$ 139.65	02.Apr.2018							John
44	43	ABC43	$ 333.45	99	$ 33,011.55	02.Apr.2018							Greg
45	44	ABC44	$ 11.99	1	$ 11.99	02.Apr.2018							Margaret
46	45	ABC45	$ 741.99	101	$ 74,940.99	02.Apr.2018	RT1	RT2	RT3	RT4	02.04.2018	02.Apr.2018	Raghu
47	46	ABC46	$ 8.51	12	$ 102.12	02.Apr.2018							John
48	47	ABC47	$ 7.22	62	$ 447.64	02.Apr.2018							Greg
49	48	ABC48	$ 3.99	35	$ 139.65	02.Apr.2018							Margaret
50	49	ABC49	$ 333.45	99	$ 33,011.55	02.Apr.2018	RT1	RT2	RT3	RT4	02.04.2018	02.Apr.2018	Raghu
51	50	ABC50	$ 11.99	1	$ 11.99	02.Apr.2018							Raghu
52

Data files after final (second) consolidation:

Using Excel 2007 32 bit

15
ABC15
$ 3.99

35

$ 139.65
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

19
ABC19
$ 55.00

22

$ 1,210.00
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

23
ABC23
$ 7.22

62

$ 447.64
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

27
ABC27
$ 741.99

101

$ 74,940.99
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

31
ABC31
$ 8.51

12

$ 102.12
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

35
ABC35
$ 11.99

1

$ 11.99
02.Apr.2018 GT1 GT2 GT3 GT4 02.Apr.2018 02.Apr.2018 Greg

39
ABC39
$ 12.99

5

$ 64.95
02.Apr.2018 Greg

Worksheet: Tabelle1

Using Excel 2007 32 bit

_Row\^Col
A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

11

37
ABC37
$ 55.00

22

$ 1,210.00
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
02.Apr.2018 Raghu

12

41
ABC41
$ 7.22

62

$ 447.64
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
02.Apr.2018 Raghu

13

45
ABC45
$ 741.99

101

$ 74,940.99
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
02.Apr.2018 Raghu

14

49
ABC49
333.45 €

99

33,011.55 €
02.Apr.2018 RT1 RT2 RT3 RT4
02. Apr 18
02.Apr.2018 Raghu

15

50
ABC50
11.99 €

1

11.99 €
02.Apr.2018 Raghu

16

Worksheet: Tabelle1

Using Excel 2007 32 bit

28
ABC28
$ 55.00

22

$ 1,210.00
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

32
ABC32
$ 7.22

62

$ 447.64
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

36
ABC36
$ 741.99

101

$ 74,940.99
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

40
ABC40
$ 8.51

12

$ 102.12
02.Apr.2018 MT1 MT2 MT3 MT4 02.Apr.2018 02.Apr.2018 Margaret

44
ABC44
$ 11.99

1

$ 11.99
02.Apr.2018 Margaret

48
ABC48
3.99 €

35

139.65 €
02.Apr.2018 Margaret

Worksheet: Tabelle1

Using Excel 2007 32 bit

26
ABC26
$ 11.99

1

$ 11.99
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

30
ABC30
$ 12.99

5

$ 64.95
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

34
ABC34
$ 333.45

99

$ 33,011.55
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

38
ABC38
$ 13.66

7

$ 95.62
02.Apr.2018 JT1 JT2 JT3 JT4 02.Apr.2018 02.Apr.2018 John

42
ABC42
$ 3.99

35

$ 139.65
02.Apr.2018 John

Worksheet: Tabelle1

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K	L	N
11	37	ABC37	$ 55.00	22	$ 1,210.00	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18	02.Apr.2018	Raghu
12	41	ABC41	$ 7.22	62	$ 447.64	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18	02.Apr.2018	Raghu
13	45	ABC45	$ 741.99	101	$ 74,940.99	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18	02.Apr.2018	Raghu
14	49	ABC49	333.45 €	99	33,011.55 €	02.Apr.2018	RT1	RT2	RT3	RT4	02. Apr 18	02.Apr.2018	Raghu
15	50	ABC50	11.99 €	1	11.99 €	02.Apr.2018							Raghu
16

Code for anwser to this Thread:
http://www.excelfox.com/forum/showth...e-folder/page2

Code:

Option Explicit Sub consolidateToo() ' http://www.excelfox.com/forum/showthread.php/2238-Copy-data-from-Unique-files-into-Masterfile-all-the-files-in-the-same-folder?p=10595#post10595 Rem 1 ThisWorkbook Info Dim MWs1 As Worksheet: Set MWs1 = ThisWorkbook.Worksheets.Item(1) 'Worksheets("OriginalData") Dim DtaFName As String: Let DtaFName = VBA.Dir(ThisWorkbook.Path & "\" & "*.xlsx") ' Search criteria set to all Files with .xlsx extension in the same Folder as this workbook, Dir returns first file name that fits criteria Dim LrMWs1 As Long: Let LrMWs1 = MWs1.Range("A" & MWs1.Rows.Count & "").End(xlUp).Row Rem 2 main Loop for all data files Do While DtaFName <> "" ' ========================================== Workbooks.Open filename:=ThisWorkbook.Path & "\" & DtaFName Dim WBDta As Workbook: Set WBDta = ActiveWorkbook Dim WBDtaWs1 As Worksheet: Set WBDtaWs1 = WBDta.Worksheets.Item(1) ' use variable to reference the first worksheet ( counting tabs from the left ) of last opened and therefore active( to be seen ) file Dim arrIn() As Variant: Let arrIn() = WBDtaWs1.Range("A1").CurrentRegion.Value '2a) loop for all data rows, copy data from completed rows to master file, ( add date to inputed data array '_-##) Dim Rw As Long ' -------------------------------- For Rw = 2 To UBound(arrIn(), 1) ' loop through "rows" in data array If arrIn(Rw, 11) <> Empty And arrIn(Rw, 12) = Empty Then ' Condition for completed work not yet consolidated Dim arrCsDte(1 To 1, 1 To 7) As String: Let arrCsDte(1, 1) = arrIn(Rw, 7): arrCsDte(1, 2) = arrIn(Rw, 8): arrCsDte(1, 3) = arrIn(Rw, 9): arrCsDte(1, 4) = arrIn(Rw, 10): arrCsDte(1, 5) = arrIn(Rw, 11): arrCsDte(1, 6) = Format(Date, "dd.mmm.yyyy"): arrCsDte(1, 7) = arrIn(Rw, 13) ' 7 "columns" of data to be added to master file MWs1.Range("A2:A" & LrMWs1 & "").Find(what:=arrIn(Rw, 1), After:=MWs1.Range("A2"), LookIn:=xlValues, Lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext).Offset(0, 6).Resize(1, 7) = arrCsDte() ' We look down the first column in the master file to find the cell comtaining the S No We apply the offest property to thast cell to get across to column G and then the resize property gives us the range of 7 columns to which we may apply the values in the array filled for the row data Let arrIn(Rw, 12) = arrCsDte(1, 6) '(Put the current date in the array made from data range '_-##) Else ' Datá row is completed and consolidated , so nothing to do for this row End If Next Rw ' End loop for all data rows -------- '2b) Update and close current data workbook Let WBDtaWs1.Range("A1").Resize(UBound(arrIn(), 1), UBound(arrIn(), 2)).Value = arrIn() ' reassign the values from the input data array back to the range as this now has the consolidated date in it WBDta.Close savechanges:=True '2c Serch for next data file name Let DtaFName = VBA.Dir() ' Unqualified Dir returns next found file with previos search criteria, but only returns each file name once Loop ' Do While DtaFName <> "" again ============================== End Sub

Checked Library Infomation Excel 2003 Excel 2007 Excel 2010

Some sample data for other Posts and Threads:
http://www.eileenslounge.com/viewtopic.php?f=30&t=29652
Using this code:

Code:

Sub Its() ' snb 2017 Dim It As Variant For Each It In ThisWorkbook.VBProject.References Dim strIts As String Let strIts = strIts & "Description:" & vbTab & It.Description & vbCr & "Name:" & vbTab & vbTab & It.Name & vbCr & "Buitin:" & vbTab & vbTab & It.BuiltIn & vbCr & "Minor:" & vbTab & vbTab & It.minor & vbCr & "Major:" & vbTab & vbTab & It.major & vbCr & "FullPath:" & vbTab & vbTab & It.fullpath & vbCr & "GUID:" & vbTab & vbTab & It.GUID & vbCr & "Type:" & vbTab & vbTab & It.Type & vbCr & "Isbroken:" & vbTab & vbTab & It.isbroken & vbCr & vbCr Next It Debug.Print strIts ' From VB Editor Ctrl+g to get Immediate Window from which info can be copied End Sub

Here some results. ( If anyone passing has other Excel versions and would like to pass on what the code above gives, then that would be nice, thanks :) )

Excel 2007

Code:

Description: Visual Basic For Applications Name: VBA Buitin: Wahr Minor: 0 Major: 4 FullPath: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL GUID: {000204EF-0000-0000-C000-000000000046} Type: 0 Isbroken: Falsch Description: Microsoft Excel 12.0 Object Library Name: Excel Buitin: Wahr Minor: 6 Major: 1 FullPath: C:\Program Files\Microsoft Office\Office12\EXCEL.EXE GUID: {00020813-0000-0000-C000-000000000046} Type: 0 Isbroken: Falsch Description: OLE Automation Name: stdole Buitin: Falsch Minor: 0 Major: 2 FullPath: C:\Windows\system32\stdole2.tlb GUID: {00020430-0000-0000-C000-000000000046} Type: 0 Isbroken: Falsch Description: Microsoft Office 12.0 Object Library Name: Office Buitin: Falsch Minor: 4 Major: 2 FullPath: C:\Program Files\Common Files\Microsoft Shared\OFFICE12\MSO.DLL GUID: {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52} Type: 0 Isbroken: Falsch Description: Microsoft Word 12.0 Object Library Name: Word Buitin: Falsch Minor: 4 Major: 8 FullPath: C:\Program Files\Microsoft Office\Office12\MSWORD.OLB GUID: {00020905-0000-0000-C000-000000000046} Type: 0 Isbroken: Falsch

Excel 2003

Code:

Description: Visual Basic For Applications Name: VBA Buitin: Wahr Minor: 0 Major: 4 FullPath: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL GUID: {000204EF-0000-0000-C000-000000000046} Type: 0 Isbroken: Falsch Description: Microsoft Excel 11.0 Object Library Name: Excel Buitin: Wahr Minor: 5 Major: 1 FullPath: C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE GUID: {00020813-0000-0000-C000-000000000046} Type: 0 Isbroken: Falsch Description: OLE Automation Name: stdole Buitin: Falsch Minor: 0 Major: 2 FullPath: C:\Windows\system32\stdole2.tlb GUID: {00020430-0000-0000-C000-000000000046} Type: 0 Isbroken: Falsch Description: Microsoft Office 11.0 Object Library Name: Office Buitin: Falsch Minor: 3 Major: 2 FullPath: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL GUID: {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52} Type: 0 Isbroken: Falsch Description: Microsoft Word 12.0 Object Library Name: Word Buitin: Falsch Minor: 4 Major: 8 FullPath: C:\Program Files\Microsoft Office\Office12\MSWORD.OLB GUID: {00020905-0000-0000-C000-000000000046} Type: 0 Isbroken: Falsch

Excel 2010

Code:

Description: Visual Basic For Applications Name: VBA Buitin: Wahr Minor: 1 Major: 4 FullPath: C:\PROGRA~2\COMMON~1\MICROS~1\VBA\VBA7\VBE7.DLL GUID: {000204EF-0000-0000-C000-000000000046} Type: 0 Isbroken: Falsch Description: Microsoft Excel 14.0 Object Library Name: Excel Buitin: Wahr Minor: 7 Major: 1 FullPath: C:\Program Files (x86)\Microsoft Office\Office14\EXCEL.EXE GUID: {00020813-0000-0000-C000-000000000046} Type: 0 Isbroken: Falsch Description: OLE Automation Name: stdole Buitin: Falsch Minor: 0 Major: 2 FullPath: C:\Windows\SysWOW64\stdole2.tlb GUID: {00020430-0000-0000-C000-000000000046} Type: 0 Isbroken: Falsch Description: Microsoft Office 14.0 Object Library Name: Office Buitin: Falsch Minor: 5 Major: 2 FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE14\MSO.DLL GUID: {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52} Type: 0 Isbroken: Falsch Description: Microsoft Word 14.0 Object Library Name: Word Buitin: Falsch Minor: 5 Major: 8 FullPath: C:\Program Files (x86)\Microsoft Office\Office14\MSWORD.OLB GUID: {00020905-0000-0000-C000-000000000046} Type: 0 Isbroken: Falsch

Test data supplied by Thainguyen

To support solution to this Thread:
http://www.excelfox.com/forum/showth...and-send-email

Test data supplied by Thainguyen for this Thread :
http://www.excelfox.com/forum/showth...and-send-email

Code:

Using Excel 2007 32 bit _Row\^Col A B C D E F G H I J K N 1 Equipment PM 2 Machine EQ.ID Manufacture Model Description Serial Number Weekly Date of Service Weekly Next Service Monthly Date of Service Monthly Next Service Quarterly Date of Service Quarterly Next Service Softwear 3 4 1 JUKI GKG GL GL SCREEN PRINTER A123 06.04.2018 13.04.2018 15.03.2018 12.04.2018 N/A N/A 5 2 JUKI KE-1070L SMT Placement Machine A124 11.04.2018 18.04.2018 28.03.2018 25.04.2018 N/A N/A 6 9 ACE Production KISS-101B Selective Wave Solder A125 06.04.2018 13.04.2018 15.03.2018 12.04.2018 N/A N/A 7 59 Heller 1826 MK5 Reflow Oven A126 N/A N/A 16.03.2018 13.04.2018 N/A N/A 8 62 Exit Sign -- N/A -- Exit Lights N/A N/A A127 N/A N/A N/A N/A N/A N/A 9 69 South-Tek System N2-Gen 35ST Nitrogen Generator A128 10.04.2018 17.04.2018 N/A N/A 09.03.2018 06.04.2018 10 75 ACE Production KISS-102 Selective Wave Solder A129 16.04.2018 23.04.2018 N/A N/A N/A N/A 11 101 FKN system N100 Nibbler Dispensing A130 N/A N/A N/A N/A 04.04.2018 02.05.2018 12 109 Mycronic MY200sx SMT Machine A131 N/A N/A N/A N/A N/A N/A 13 112 X-TEK XTV-160 X-Ray System A132 N/A N/A N/A N/A N/A N/A 14 113 MIRTEC MV-6 OMNI AOI A133 N/A N/A N/A N/A N/A N/A 15 116 JUKI KE-2060RL SMT Placement Machine A134 N/A N/A N/A N/A N/A N/A 16 127 ELGI EG22-150 Air Compressor A135 N/A N/A N/A N/A N/A N/A 17 128 Juki KE-2050 SMT A136 N/A N/A N/A N/A N/A N/A 18 137 Juki K3 Screen printer A137 06.04.2018 13.04.2018 N/A N/A N/A N/A 19 141 Heller 1826 MK5 Reflow Oven A138 N/A N/A N/A N/A N/A N/A 20 142 NISSAN MCU-112A331.V Forklift A139 N/A N/A N/A N/A 15.02.2018 15.03.2018 21 142 NISSAN/yearly oil change and lube MCU-112A331.V Forklift A140 N/A N/A N/A N/A N/A N/A 22 28.01.1900 23 Worksheet: Equipment PM

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K	N
1	Equipment PM
2	Machine EQ.ID	Manufacture	Model	Description	Serial Number	Weekly Date of Service	Weekly Next Service	Monthly Date of Service	Monthly Next Service	Quarterly Date of Service	Quarterly Next Service	Softwear
3
4	1	JUKI	GKG GL	GL SCREEN PRINTER	A123	06.04.2018	13.04.2018	15.03.2018	12.04.2018	N/A	N/A
5	2	JUKI	KE-1070L	SMT Placement Machine	A124	11.04.2018	18.04.2018	28.03.2018	25.04.2018	N/A	N/A
6	9	ACE Production	KISS-101B	Selective Wave Solder	A125	06.04.2018	13.04.2018	15.03.2018	12.04.2018	N/A	N/A
7	59	Heller	1826 MK5	Reflow Oven	A126	N/A	N/A	16.03.2018	13.04.2018	N/A	N/A
8	62	Exit Sign -- N/A -- Exit Lights	N/A	N/A	A127	N/A	N/A	N/A	N/A	N/A	N/A
9	69	South-Tek System	N2-Gen 35ST	Nitrogen Generator	A128	10.04.2018	17.04.2018	N/A	N/A	09.03.2018	06.04.2018
10	75	ACE Production	KISS-102	Selective Wave Solder	A129	16.04.2018	23.04.2018	N/A	N/A	N/A	N/A
11	101	FKN system	N100 Nibbler	Dispensing	A130	N/A	N/A	N/A	N/A	04.04.2018	02.05.2018
12	109	Mycronic	MY200sx	SMT Machine	A131	N/A	N/A	N/A	N/A	N/A	N/A
13	112	X-TEK	XTV-160	X-Ray System	A132	N/A	N/A	N/A	N/A	N/A	N/A
14	113	MIRTEC	MV-6 OMNI	AOI	A133	N/A	N/A	N/A	N/A	N/A	N/A
15	116	JUKI	KE-2060RL	SMT Placement Machine	A134	N/A	N/A	N/A	N/A	N/A	N/A
16	127	ELGI	EG22-150	Air Compressor	A135	N/A	N/A	N/A	N/A	N/A	N/A
17	128	Juki	KE-2050	SMT	A136	N/A	N/A	N/A	N/A	N/A	N/A
18	137	Juki	K3	Screen printer	A137	06.04.2018	13.04.2018	N/A	N/A	N/A	N/A
19	141	Heller	1826 MK5	Reflow Oven	A138	N/A	N/A	N/A	N/A	N/A	N/A
20	142	NISSAN	MCU-112A331.V	Forklift	A139	N/A	N/A	N/A	N/A	15.02.2018	15.03.2018
21	142	NISSAN/yearly oil change and lube	MCU-112A331.V	Forklift	A140	N/A	N/A	N/A	N/A	N/A	N/A
22											28.01.1900
23

Another view of last table

( for Thread: http://www.excelfox.com/forum/showth...and-send-email )

Using Excel 2007 32 bit

Equipment PM

Machine EQ.ID

Manufacture

Model

Description

Serial Number

Weekly
Date of Service

Weekly
Next Service

Monthly
Date of Service

Monthly
Next Service

Quarterly
Date of Service

Quarterly
Next Service

1
JUKI GKG GL GL SCREEN PRINTER A123
06.04.2018

13.04.2018

15.03.2018

12.04.2018

N/A

N/A

2
JUKI KE-1070L SMT Placement Machine A124
11.04.2018

18.04.2018

28.03.2018

25.04.2018

N/A

N/A

9
ACE Production KISS-101B Selective Wave Solder A125
06.04.2018

13.04.2018

15.03.2018

12.04.2018

N/A

N/A

59
Heller 1826 MK5 Reflow Oven A126
N/A

N/A

16.03.2018

13.04.2018

N/A

N/A

62
Exit Sign -- N/A -- Exit Lights N/A N/A A127
N/A

N/A

N/A

N/A

N/A

N/A

69
South-Tek System N2-Gen 35ST Nitrogen Generator A128
10.04.2018

17.04.2018

N/A

N/A

09.03.2018

06.04.2018

75
ACE Production KISS-102 Selective Wave Solder A129
16.04.2018

23.04.2018

N/A

N/A

N/A

N/A

101
FKN system N100 Nibbler Dispensing A130
N/A

N/A

N/A

N/A

04.04.2018

02.05.2018

109
Mycronic MY200sx SMT Machine A131
N/A

N/A

N/A

N/A

N/A

N/A

112
X-TEK XTV-160 X-Ray System A132
N/A

N/A

N/A

N/A

N/A

N/A

113
MIRTEC MV-6 OMNI AOI A133
N/A

N/A

N/A

N/A

N/A

N/A

116
JUKI KE-2060RL SMT Placement Machine A134
N/A

N/A

N/A

N/A

N/A

N/A

127
ELGI EG22-150 Air Compressor A135
N/A

N/A

N/A

N/A

N/A

N/A

128
Juki KE-2050 SMT A136
N/A

N/A

N/A

N/A

N/A

N/A

137
Juki K3 Screen printer A137
06.04.2018

13.04.2018

N/A

N/A

N/A

N/A

141
Heller 1826 MK5 Reflow Oven A138
N/A

N/A

N/A

N/A

N/A

N/A

142
NISSAN MCU-112A331.V Forklift A139
N/A

N/A

N/A

N/A

15.02.2018

15.03.2018

142
NISSAN/yearly oil change and lube MCU-112A331.V Forklift A140
N/A

N/A

N/A

N/A

N/A

N/A

28.01.1900

Worksheet: Equipment PM

Table from above again
Using Excel 2007 32 bit

_Row\^Col
F

G

H

I

J

K

1

2

Weekly
Date of Service

Weekly
Next Service

Monthly
Date of Service

Monthly
Next Service

Quarterly
Date of Service

Quarterly
Next Service

3

4

06.04.2018

13.04.2018

15.03.2018

12.04.2018

N/A

N/A

5

11.04.2018

18.04.2018

28.03.2018

25.04.2018

N/A

N/A

6

06.04.2018

13.04.2018

15.03.2018

12.04.2018

N/A

N/A

7

N/A

N/A

16.03.2018

13.04.2018

N/A

N/A

8

N/A

N/A

N/A

N/A

N/A

N/A

9

10.04.2018

17.04.2018

N/A

N/A

09.03.2018

06.04.2018

10

16.04.2018

23.04.2018

N/A

N/A

N/A

N/A

11

N/A

N/A

N/A

N/A

04.04.2018

02.05.2018

12

N/A

N/A

N/A

N/A

N/A

N/A

13

N/A

N/A

N/A

N/A

N/A

N/A

14

N/A

N/A

N/A

N/A

N/A

N/A

15

N/A

N/A

N/A

N/A

N/A

N/A

16

N/A

N/A

N/A

N/A

N/A

N/A

17

N/A

N/A

N/A

N/A

N/A

N/A

18

06.04.2018

13.04.2018

N/A

N/A

N/A

N/A

19

N/A

N/A

N/A

N/A

N/A

N/A

20

N/A

N/A

N/A

N/A

15.02.2018

15.03.2018

21

N/A

N/A

N/A

N/A

N/A

N/A

22

28.01.1900

Worksheet: Equipment PM

_Row\^Col	F	G	H	I	J	K
1
2	Weekly Date of Service	Weekly Next Service	Monthly Date of Service	Monthly Next Service	Quarterly Date of Service	Quarterly Next Service
3
4	06.04.2018	13.04.2018	15.03.2018	12.04.2018	N/A	N/A
5	11.04.2018	18.04.2018	28.03.2018	25.04.2018	N/A	N/A
6	06.04.2018	13.04.2018	15.03.2018	12.04.2018	N/A	N/A
7	N/A	N/A	16.03.2018	13.04.2018	N/A	N/A
8	N/A	N/A	N/A	N/A	N/A	N/A
9	10.04.2018	17.04.2018	N/A	N/A	09.03.2018	06.04.2018
10	16.04.2018	23.04.2018	N/A	N/A	N/A	N/A
11	N/A	N/A	N/A	N/A	04.04.2018	02.05.2018
12	N/A	N/A	N/A	N/A	N/A	N/A
13	N/A	N/A	N/A	N/A	N/A	N/A
14	N/A	N/A	N/A	N/A	N/A	N/A
15	N/A	N/A	N/A	N/A	N/A	N/A
16	N/A	N/A	N/A	N/A	N/A	N/A
17	N/A	N/A	N/A	N/A	N/A	N/A
18	06.04.2018	13.04.2018	N/A	N/A	N/A	N/A
19	N/A	N/A	N/A	N/A	N/A	N/A
20	N/A	N/A	N/A	N/A	15.02.2018	15.03.2018
21	N/A	N/A	N/A	N/A	N/A	N/A
22						28.01.1900

Code for this Thread:
http://www.excelfox.com/forum/showth...and-send-email

Code:

Option Explicit Private Sub Workbook_Open() Rem 1 Worksheets Info. Dim Ws As Worksheet: Set Ws = ThisWorkbook.Worksheets("Equipment PM") Dim Lr As Long: Let Lr = Ws.Range("A" & Ws.Rows.Count & "").End(xlUp).Row Rem 2 data range Dim arrIn() As Variant: Let arrIn() = Ws.Range("A1:K" & Lr & "").Value2 Rem 3 Todays date as Double(Long) number Dim TdyDbl As Long: Let TdyDbl = CLng(Now()) ' like 43233 for 13 May 2018 Let TdyDbl = CLng(DateSerial(2018, 3, 15)) - 3 ' To test only ##### Rem 4 Rows for due date for next service for weekly(G), Monthly(I), and Quarterly(K). Code to pick up the date from these columns and automatic send email notification 3 days before the due date. '4a) determine rows as string or those row numbers Dim Rw As Long For Rw = 4 To Lr Step 1 If arrIn(Rw, 7) = TdyDbl + 3 Or arrIn(Rw, 9) = TdyDbl + 3 Or arrIn(Rw, 11) = TdyDbl + 3 Then Dim strRws As String 'String of rows for criteria met in G Or I Or K Let strRws = strRws & " " & Rw Else ' No "3 days before due service date" criteria met for this row End If Next Rw If strRws = "" Then Exit Sub ' case no criteria met for the day this workbook was opened. Let strRws = VBA.Strings.Mid$(strRws, 2) ' take off first space '4b) Array of rows Dim arrRws() As String: Let arrRws() = VBA.Strings.Split(strRws, " ", -1, vbBinaryCompare) Rem 5 HTML Table of required output ' Dim ProTble As String '5a) Table start Let ProTble = _ "<table width=520>" & vbCrLf & _ "<col width=30>" & vbCrLf & _ "<col width=150>" & vbCrLf & _ "<col width=150>" & vbCrLf & _ "<col width=150>" & vbCrLf & _ "<col width=40>" & vbCrLf & vbCrLf '5b) data rows Dim iCnt As Long, jCntStear As Variant, jCnt As Long ' data "columns" , "rows" For Each jCntStear In arrRws() ' To Loop for all rows meeting criteria Let jCnt = jCnt + 1 ' Rows count for table to send Dim LisRoe As String Let LisRoe = LisRoe & "<tr height=16>" & vbCrLf For iCnt = 1 To 5 Let LisRoe = LisRoe & "<td>" & arrIn(arrRws(jCnt - 1), iCnt) & "</td>" & vbCrLf ' -1 is because Split Function returns array of string types in 1 Dimensional array starting at indice 0, so our jCnt is one too big Next iCnt Let LisRoe = LisRoe & "</tr>" & vbCrLf & vbCrLf Let ProTble = ProTble & LisRoe Let LisRoe = "" Next jCntStear Let ProTble = ProTble & "</table>" ' table end Debug.Print ProTble Rem 6 EMail send 'For info see: http://www.excelfox.com/forum/showth...once#post10519 'Working at my end With my With End With Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups) With CreateObject("CDO.Message") ' -Linking Cods Wollups-------- Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/" .Configuration(LCD_CW & "smtpusessl") = True ' .Configuration(LCD_CW & "smtpauthenticate") = 1 ' ' ' Sever info .Configuration(LCD_CW & "smtpserver") = "smtp.gmail.com" ' "securesmtp.t-online.de" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com" "smtp-mail.outlook.com" "smtp.live.com" "securesmtp.t-online.de" ' The mechanism to use to send messages. .Configuration(LCD_CW & "sendusing") = 2 ' Based on the LCD_OLE Data Base of type DBTYPE_I4 .Configuration(LCD_CW & "smtpserverport") = 25 ' 465 or 25 for t-online.de 'or 587 'or 25 ' .Configuration(LCD_CW & "sendusername") = "YourEMailAddress" .Configuration(LCD_CW & "sendpassword") = "YourEMailPassword" ' Optional - How long to try .Configuration(LCD_CW & "smtpconnectiontimeout") = 30 ' ' Intraction protocol is Set/ Updated .Configuration.Fields.Update ' 'End With ' ---------------------- my Created LCDCW Library 'With ' --- ' Data to be sent------ my Created LCDCW Library Dim strHTML As String: Let strHTML = ProTble 'ProTble(rngArr()) ' Let strHTML = RangetoHTML(rng) ' Dim Highway1 As Long: Let Highway1 = FreeFile(0) ' ' Open ThisWorkbook.Path & "" & "jawaharse.txt" For Output As #Highway1 ' ' Print #Highway1, strHTML ' Close #Highway1 .To = "Doc.AElstein@t-online.de" ' .cc = "" .BCC = "" .from = """Equipment- Maint Records.xlsm"" <YourEMailAddresseOrAnyCrap>" .Subject = Ws.Range("A1").Value .HTMLBody = strHTML ' .AddAttachment ThisWorkbook.Path & "\jawaharse.txt" .Send ' Do it End With ' CreateObject("CDO.Message") -----my Created LCDCW Library End Sub

1 Attachment(s)

Re Post code with Code tags

To support this Thread
http://www.excelfox.com/forum/showth...0679#post10679

Re post code in Code tags, Like ....

Please use CODE TAGS if you are writing codes in your post.

To use code tags,
either
select your entire code and press the code tag button # in the editor below,
or
simply type your code as below

[Code]Your Code Here[/Code]

[Code]
Your Code Here
[/Code]

[Code]
Private Sub cmdNot_Click()

Dim OutApp As Object
Dim OutMail As Object

…………………….

……………..

End Sub
[/Code]

BBCodeCodeTags.JPG : https://imgur.com/4HunNcs
Attachment 2060

_.__________________

If you post using Code tags, then it will come out in the final post in a Code Window, like this:

Code:

Private Sub cmdNot_Click() Dim OutApp As Object Dim OutMail As Object Dim fileName As String Dim mSubject As String Dim signature As String Dim fname As String Dim mBody As String Dim rng As Range Dim rng1 As Range Dim ws As Worksheet Dim mailTo As String Set ws = Sheets("MRO") fname = ws.Range("B4") mSubject = "MRO " & " For " & Range("C6").Value Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) 'mBody = "2-SO\Material Request Form .xlsm" Dim Path As String mBody = "" & _ "Dear Team, " & _ "Please open the file from below link and put your signature on the respective cell after you completed your task. " & _ fileName & ".xlsm" & " is created. " & _ "Click on this link to open the file : " & _ "<A HREF=""file://" & Path & fileName & ".xlsm" & _ """>Files are saved here</A>" & "-->" & Range("C6").Value & _ " Best Regards," & _ " " With OutMail .display End With signature = OutMail.body With Application .EnableEvents = False .ScreenUpdating = False End With With OutMail '.To = "email" .To = "" .CC = "" .BCC = "" .Subject = mSubject '.body = "Dear Team," & vbCrLf & vbCrLf & "Please open the file from below link and put your signature on the respective cell and save the sheet" '.htmlbody = RangetoHTML(rng) .htmlbody = mBody '.Attachments.Add fileName .display End With 'ws.PageSetup.RightHeader = "&""Calibri,italic""&11& " & ws.Range("A1") ActiveWorkbook.Close False ActiveWorkbook.Close On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With

Code in code tags from here:
http://www.excelfox.com/forum/showth...0699#post10699

Code:

Dim OutApp As Object Dim OutMail As Object Dim fileName As String Dim mSubject As String Dim signature As String Dim fname As String Dim mBody As String Dim rng As Range Dim rng1 As Range Dim ws As Worksheet Dim mailTo As String fname = ws.Range("A1") mSubject = "Equipment" & " For " & Range("A1").Value Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) 'mBody = "Z:\2\Form\\Manufacturing Order.xlsm" Dim Path As String ws.Protect ("Equipment") Path = "\\Equipment- Maint RecordsThai1.xlsm" mBody = "" & _ "Dear Team, " & _ "Please open the file from below link and change the date on the respective cell after you completed your task. " & _ fileName & ".xlsm" & " is created. " & _ "Click on this link to open the file : " & _ "<A HREF=""file://" & Path & fileName & ".xlsm" & _ """>Files are saved here</A>" & "-->" & Range("A1").Value & _ " Best Regards," & _ " " With OutMail .display End With signature = OutMail.body With Application .EnableEvents = False .ScreenUpdating = False End With

Code:

Private Sub cmdNot_Click() If Application.UserName = "Thai Nguyen" Then Dim ws As Worksheet: Set ws = Sheets("Name") Dim rng As Range, rng1 As Range Dim fileName As String, fname As String Let fname = ws.Range("B4") Let mSubject = "Name" Dim OutApp As Object, OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) Dim Subject As String, signature As String, mBody As String, mailTo As String 'mBody = "copy you link path in here" Let mBody = "" & _ "Hi Team, " & _ "Please open the file from below link and put your signature on the respective cell after you completed your task. " & _ ActiveWorkbook.Name & " is created. " & _ "Click on this link to open the file : " & _ "<A HREF=""file://" & ActiveWorkbook.FullName & """>Link to the file</A>" & _ " Regards," & _ " Thai Nguyen " OutMail.display Let signature = OutMail.body With Application .EnableEvents = False .ScreenUpdating = False End With With OutMail '.To = "email" If ws.Range("EU16") = True Then Let mailTo = mailTo + "Thai Nguyen;" Else End If If ws.Range("EU17") = True Then mailTo = mailTo + "email" End If If ws.Range("EU18") = True Then Let mailTo = mailTo + "email" End If If ws.Range("EU19") = True Then Let mailTo = mailTo + "email" End If .To = mailTo .CC = "Thai Nguyen" .BCC = "" .Subject = mSubject '.body = "Hi Team," & vbCrLf & vbCrLf & "Please open the file from below link and put your signature on the respective cell and save the sheet" '.htmlbody = RangetoHTML(rng) .htmlbody = mBody '.Attachments.Add fileName .display End With 'ws.PageSetup.RightHeader = "&""Calibri,italic""&11& " & ws.Range("A1") ws.Protect ("Name") ActiveWorkbook.Save ActiveWorkbook.Close On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With Else MsgBox "You are not authorised to send BOM form, please check with BOM owner" End If End Sub

Share account for testing file access from a hyperlink in a received EMail

Share account for testing file access from a hyperlink in a received EMail
In support of a possible solution to this post in this Thread:
http://www.excelfox.com/forum/showth...0724#post10724

It is required to have a simple hyperlink to an Excel File appear in the received Email sent to members of a team.
I am not sure currently how to get a link directly to the File.

An second alternative involves storing the file at a File sharing site and using the link to the file as the URL part of a hyperlink.

This post discusses the setting up of such an account to allow storing of, and sharing via a supplied link to, the file.

As an example of a file sharing site we consider the free version of box.net
Some googling my be needed to finally get at the free version which may go under the name of “free” , “Individual rate”, “Personal free”
Currently you need to find your way to the free 10GB offer. This is currently at this link:
https://account.box.com/signup/n/personal#fbms6
Free10GB box net account register.JPG : https://imgur.com/NB3GThi
Note , by registering, you can choose a language to suit you.
Free10GB Select language .JPG : : https://imgur.com/aNzW1kq
( You can change the language to a different one after registering also
Free10GB Change language .JPG : https://imgur.com/IosqbAI )

For this registering , I use the created gmail account used for experiments in the current thread which this post supports, excellearning12@gmail.com ( excelfox Thread : http://www.excelfox.com/forum/showth...and-send-email )

The password I pass on privately to those needing
Free10GB box net account register 2.JPG : https://imgur.com/Y2pLogO
Free10GB box net account register 3.JPG : https://imgur.com/QhCR8fP
Free10GB box net account register Verify Email 4.JPG : https://imgur.com/ffG7erw

Various steps are then gone through, they may be slightly different to the following:

At some point you should you should see the possibility to upload a file, following steps similar to these:
Free10GB box net 5 .JPG : https://imgur.com/lNWvQwF
To upload a file and get a URL link to use in a hyperlink to it:
Upload Files:
Free10GB box net 6 .JPG : https://imgur.com/rTU1Xbk
Select a file:
Free10GB box net 7 .JPG : https://imgur.com/wKKlqoO
Select share to obtain a URL link to the file :
Free10GB box net 8 .JPG : https://imgur.com/R3VbyhR
Copy link to be used in Hyperlink :
Free10GB box net 9 .JPG : https://imgur.com/8yaYwaK

Testing Hyperlinks in received EMail

Testing codes in support of this Thread
http://www.excelfox.com/forum/showth...0727#post10727

Codes for Alf and sandy666

Code:

Option Explicit Sub SendfromExcelVBAExpgmail() Rem 6 EMail send 'For info see: http://www.excelfox.com/forum/showthread.php/2233-Urgent-support-needed-Multiple-emails-multiple-Excel-workbooks-at-once#post10519 'Working at my end With my With End With Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups) '6a(i) With CreateObject("CDO.Message") ' -Linking Cods Wollups-------- Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/" .Configuration(LCD_CW & "smtpusessl") = True ' .Configuration(LCD_CW & "smtpauthenticate") = 1 ' ' ' Sever info .Configuration(LCD_CW & "smtpserver") = "smtp.gmail.com" ' "smtp.office365.com" ' "smtp.live.com" ' "smtp-mail.outlook.com" ' "smtp.live.com" ' "smtp.gmail.com" ' "securesmtp.t-online.de" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com" "smtp-mail.outlook.com" "smtp.live.com" "securesmtp.t-online.de" ' The mechanism to use to send messages. .Configuration(LCD_CW & "sendusing") = 2 ' Based on the LCD_OLE Data Base of type DBTYPE_I4 .Configuration(LCD_CW & "smtpserverport") = 465 ' 465 or 25 for gmail '587 ' 25 ' 465 or 25 for t-online.de 'or 587 'or 25 ' .Configuration(LCD_CW & "sendusername") = "ExcelVBAExp@gmail.com" ' .Configuration(LCD_CW & "sendpassword") = "xxxxxxxxxxxxxx" ' ' ' .Configuration(LCD_CW & "sendusername") = "YourEMailAddress" ' .Configuration(LCD_CW & "sendpassword") = "YourEMailPassword" ' Optional - How long to try .Configuration(LCD_CW & "smtpconnectiontimeout") = 30 ' ' Intraction protocol is Set/ Updated .Configuration.Fields.Update ' 'End With 6a(i)' ---------------------- my Created LCDCW Library '6a(ii) With ' -- ' Data to be sent--- my Created LCDCW Library Dim strHTML As String: Let strHTML = "" & _ "This is sent from EMail account:" & _ " Username: ""ExcelVBAExp@gmail.com""" & _ " Password: ""xxxxxxxxxxxxxxxxxxxxxx""" & _ " " & _ " Please click on the 5 links below and tell me what happens, thanks!" & _ " 1 <A HREF=""https://app.box.com/s/x01liz3ralbdrt152i52fpwb0wx40ff3"">link to box net cloud free file sharing</A>" & _ " 2 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _ " 3 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _ " 4 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>" & _ " 5 <A HREF=""file:///" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>" .To "xxxxxxxxxxxxxx" .CC "xxxxxxxxxxxxxa" .BCC = "" .from = """ExcelVBAExp@gmail.com"" <ExcelVBAExp@gmail.com>" .Subject = "Sent from EMail address: ExcelVBAExp@gmail.com" .htmlbody = strHTML .Send ' Do it End With ' 6a(ii) CreateObject("CDO.Message") ---my Created LCDCW Library End Sub Sub SendfromFahrradprinzessinunterwegsgmail() Rem 6 EMail send 'For info see: http://www.excelfox.com/forum/showthread.php/2233-Urgent-support-needed-Multiple-emails-multiple-Excel-workbooks-at-once#post10519 'Working at my end With my With End With Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups) '6a(i) With CreateObject("CDO.Message") ' -Linking Cods Wollups-------- Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/" .Configuration(LCD_CW & "smtpusessl") = True ' .Configuration(LCD_CW & "smtpauthenticate") = 1 ' ' ' Sever info .Configuration(LCD_CW & "smtpserver") = "smtp.gmail.com" ' "smtp.office365.com" ' "smtp.live.com" ' "smtp-mail.outlook.com" ' "smtp.live.com" ' "smtp.gmail.com" ' "securesmtp.t-online.de" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com" "smtp-mail.outlook.com" "smtp.live.com" "securesmtp.t-online.de" ' The mechanism to use to send messages. .Configuration(LCD_CW & "sendusing") = 2 ' Based on the LCD_OLE Data Base of type DBTYPE_I4 .Configuration(LCD_CW & "smtpserverport") = 465 ' 465 or 25 for gmail '587 ' 25 ' 465 or 25 for t-online.de 'or 587 'or 25 ' .Configuration(LCD_CW & "sendusername") = "Fahrradprinzessinunterwegs@gmail.com" ' .Configuration(LCD_CW & "sendpassword") = "xxxxxxxxxxxxx" ' ' ' .Configuration(LCD_CW & "sendusername") = "YourEMailAddress" ' .Configuration(LCD_CW & "sendpassword") = "YourEMailPassword" ' Optional - How long to try .Configuration(LCD_CW & "smtpconnectiontimeout") = 30 ' ' Intraction protocol is Set/ Updated .Configuration.Fields.Update ' 'End With 6a(i)' ---------------------- my Created LCDCW Library '6a(ii) With ' -- ' Data to be sent--- my Created LCDCW Library Dim strHTML As String: Let strHTML = "" & _ "This is sent from EMail account:" & _ " Username: ""Fahrradprinzessinunterwegs@gmail.com""" & _ " Password: ""xxxxxxxxxxxxxxxxxxx""" & _ " " & _ " Please click on the 5 links below and tell me what happens, thanks!" & _ " 1 <A HREF=""https://app.box.com/s/x01liz3ralbdrt152i52fpwb0wx40ff3"">link to box net cloud free file sharing</A>" & _ " 2 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _ " 3 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _ " 4 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>" & _ " 5 <A HREF=""file:///" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>" .To "xxxxxxxxxxxxxxxxxxxx" .CC "xxxxxxxxxxxxxxxxxxx" .BCC = "" .from = """Fahrradprinzessinunterwegs@gmail.com"" <Fahrradprinzessinunterwegs@gmail.com>" .Subject = "Sent from EMail address: Fahrradprinzessinunterwegs@gmail.com" .htmlbody = strHTML .Send ' Do it End With ' 6a(ii) CreateObject("CDO.Message") ---my Created LCDCW Library End Sub Sub SendfromDocAlnsteinGermanTelekom() Rem 6 EMail send 'For info see: http://www.excelfox.com/forum/showthread.php/2233-Urgent-support-needed-Multiple-emails-multiple-Excel-workbooks-at-once#post10519 'Working at my end With my With End With Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups) '6a(i) With CreateObject("CDO.Message") ' -Linking Cods Wollups-------- Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/" .Configuration(LCD_CW & "smtpusessl") = True ' .Configuration(LCD_CW & "smtpauthenticate") = 1 ' ' ' Sever info .Configuration(LCD_CW & "smtpserver") = "securesmtp.t-online.de" ' "smtp.gmail.com" ' "smtp.office365.com" ' "smtp.live.com" ' "smtp-mail.outlook.com" ' "smtp.live.com" ' "smtp.gmail.com" ' "securesmtp.t-online.de" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com" "smtp-mail.outlook.com" "smtp.live.com" "securesmtp.t-online.de" ' The mechanism to use to send messages. .Configuration(LCD_CW & "sendusing") = 2 ' Based on the LCD_OLE Data Base of type DBTYPE_I4 .Configuration(LCD_CW & "smtpserverport") = 465 ' 465 or 25 for gmail '587 ' 25 ' 465 or 25 for t-online.de 'or 587 'or 25 ' .Configuration(LCD_CW & "sendusername") = "Doc.Alnstein@t-online.de" ' .Configuration(LCD_CW & "sendpassword") = "xxxxxxxxx" ' ' ' .Configuration(LCD_CW & "sendusername") = "YourEMailAddress" ' .Configuration(LCD_CW & "sendpassword") = "YourEMailPassword" ' Optional - How long to try .Configuration(LCD_CW & "smtpconnectiontimeout") = 30 ' ' Intraction protocol is Set/ Updated .Configuration.Fields.Update ' 'End With 6a(i)' ---------------------- my Created LCDCW Library '6a(ii) With ' -- ' Data to be sent--- my Created LCDCW Library Dim strHTML As String: Let strHTML = "" & _ "This is sent from EMail account:" & _ " Username: ""Doc.Alnstein@t-online.de""" & _ " Password: ""xxxxxxxxxxx""" & _ " " & _ " Please click on the 5 links below and tell me what happens, thanks!" & _ " 1 <A HREF=""https://app.box.com/s/x01liz3ralbdrt152i52fpwb0wx40ff3"">link to box net cloud free file sharing</A>" & _ " 2 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _ " 3 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _ " 4 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>" & _ " 5 <A HREF=""file:///" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>" .To "xxxxxxxxxxxxxxxxxxxxxxxx" .CC "xxxxxxxxxxxxxxxxxxxxxxxxx" .BCC = "" .from = """Doc.Alnstein@t-online.de"" <Doc.Alnstein@t-online.de>" .Subject = "Sent from EMail address: Doc.Alnstein@t-online.de" .htmlbody = strHTML .Send ' Do it End With ' 6a(ii) CreateObject("CDO.Message") ---my Created LCDCW Library End Sub

Instructions:
Three files are attached. Please download them and store them all somewhere on your computer. They can be stored anywhere, but important is that they are all stored in the same Folder :
All 3 files stored in same place.JPG : https://imgur.com/rFu0TML

Please open only one file “Test File xxxx to send EMail containing Hyperlinks to Files.xlsm”
Enable macros.

There are three codes in file “Test File xxxx to send EMail containing Hyperlinks to Files.xlsm”.
The codes are very similar, differing only in the Email account used as the .Sender:
Sub SendfromDocAlnsteinGermanTelekom()
Sub SendfromFahrradprinzessinunterwegsgmail()
Sub SendfromExcelVBAExpgmail()

Please try to run those codes.
Each code should send you an Email which on arrival will look something similar to this:
Typical received EMail.JPG : https://imgur.com/4oNXNtW

Please click on the 5 Hyperlinks and tell me what happens.

My final goal is to get a Hyperlink which when clicked opens an Excel or Word File.
I have tested the codes sending to my gmail and German Telekom Email accounts.
But so far, only link 1 works. But link 1 does not open a file: It simply sends you to a file sharing site. So link 1 is a temporary solution for me.

Code for Thai in next post....

2 Attachment(s)

Code for Thai .

Code:

Option Explicit Sub Sendfromexcellearninggmail() Rem 6 EMail send 'For info see: http://www.excelfox.com/forum/showthread.php/2233-Urgent-support-needed-Multiple-emails-multiple-Excel-workbooks-at-once#post10519 'Working at my end With my With End With Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups) '6a(i) With CreateObject("CDO.Message") ' -Linking Cods Wollups-------- Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/" .Configuration(LCD_CW & "smtpusessl") = True ' .Configuration(LCD_CW & "smtpauthenticate") = 1 ' ' ' Sever info .Configuration(LCD_CW & "smtpserver") = "smtp.gmail.com" ' "smtp.office365.com" ' "smtp.live.com" ' "smtp-mail.outlook.com" ' "smtp.live.com" ' "smtp.gmail.com" ' "securesmtp.t-online.de" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com" "smtp-mail.outlook.com" "smtp.live.com" "securesmtp.t-online.de" ' The mechanism to use to send messages. .Configuration(LCD_CW & "sendusing") = 2 ' Based on the LCD_OLE Data Base of type DBTYPE_I4 .Configuration(LCD_CW & "smtpserverport") = 465 ' 465 or 25 for gmail '587 ' 25 ' 465 or 25 for t-online.de 'or 587 'or 25 ' .Configuration(LCD_CW & "sendusername") = "excellearning12@gmail.com" ' .Configuration(LCD_CW & "sendpassword") = "xxxxxxxxxxxxx" ' ' ' .Configuration(LCD_CW & "sendusername") = "YourEMailAddress" ' .Configuration(LCD_CW & "sendpassword") = "YourEMailPassword" ' Optional - How long to try .Configuration(LCD_CW & "smtpconnectiontimeout") = 30 ' ' Intraction protocol is Set/ Updated .Configuration.Fields.Update ' 'End With 6a(i)' ---------------------- my Created LCDCW Library '6a(ii) With ' -- ' Data to be sent--- my Created LCDCW Library Dim strHTML As String: Let strHTML = "" & _ "This is sent from EMail account:" & _ " Username: ""excellearning12@gmail.com""" & _ " Password: ""xxxxxxxxxxxxx""" & _ " " & _ " Please click on the 5 links below and tell me what happens, thanks!" & _ " 1 <A HREF=""https://app.box.com/s/x01liz3ralbdrt152i52fpwb0wx40ff3"">link to box net cloud free file sharing</A>" & _ " 2 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _ " 3 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _ " 4 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>" & _ " 5 <A HREF=""file:///" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>" .To = "THai xxxxxxxxx" '.CC = "xxxxxxxxxxxxx" .BCC = "" .from = """excellearning12@gmail.com"" <excellearning12@gmail.com>" .Subject = "Sent from EMail address: excellearning12@gmail.com" .htmlbody = strHTML .Send ' Do it End With ' 6a(ii) CreateObject("CDO.Message") ---my Created LCDCW Library End Sub

Testing files( sent privately ) :
I have also posted 3 files to you using our share g mail account , ExcelVBAExp@gmail.com
Please can you also try out the test…

Please do the following.

_1) Download all three files , and important: All must be stored in the same Folder.
( the three files are:
Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received Email.htm
Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls
Test File Thai to send EMail containing Hyperlinks to Files.xlsm )

_2) Open only file Test File Thai to send EMail containing Hyperlinks to Files.xlsm
Run code Sub Sendfromexcellearninggmail()

You should receive an Email similar to these:
Alan 5 Links in German Telekom.JPG : https://imgur.com/LeASbhf
Attachment 2079
Alan 5 Links in gmail.JPG : https://imgur.com/0sdyZEj
Attachment 2080

_3) Please click on the links.

_4) Please reply and tell me what happens when you click each link

Thanks
Alan

First test code for solution to this thread:
http://www.excelfox.com/forum/showth...le-or-two-tabs

( Run code Sub TestieCalls() )

Code:

Option Explicit Sub TestieCalls() Call Testie(Worksheets("Sheet1"), Worksheets("Sheet2")) End Sub Sub Testie(Ws1 As Worksheet, Ws2 As Worksheet) Rem 1 Worksheet data info '1a capture data '1a(i) last data rows Dim lr1_1 As Long, Lr1_2 As Long, Lr2_1 As Long, Lr2_2 As Long, Lr1 As Long, lr2 As Long Let lr1_1 = Ws1.Cells(Rows.Count, 1).End(xlUp).row Let Lr1_2 = Ws1.Cells(Rows.Count, 2).End(xlUp).row: Lr2_1 = Ws2.Cells(Rows.Count, 1).End(xlUp).row: Lr2_2 = Ws2.Cells(Rows.Count, 2).End(xlUp).row If lr1_1 > Lr1_2 Then Let Lr1 = lr1_1 Else Let Lr1 = Lr1_2 End If Let lr2 = Lr2_2: If Lr2_1 > Lr2_2 Then Let lr2 = Lr2_1 '1a(ii) capture data into arrays in one go Dim arrSht1() As Variant, arrSht2() As Variant Let arrSht1() = Ws1.Range("A1:B" & Lr1 & "").Value Let arrSht2() = Ws2.Range("A1:B" & lr2 & "").Value Rem 2 arrays for check and output Dim arrSht1b() As String, arrOut() As String '2a size arrays to that of sheet 2 data ReDim arrSht1b(1 To UBound(arrSht2(), 1), 1 To UBound(arrSht2(), 2)) ReDim arrOut(1 To UBound(arrSht2(), 1), 1 To UBound(arrSht2(), 2)) '2b fill modified sheet 1 array, arrSht1b() , initially with sheet 1 data Dim Cnt As Long For Cnt = 1 To UBound(arrSht1(), 1) Step 1 Let arrSht1b(Cnt, 1) = arrSht1(Cnt, 1): Let arrSht1b(Cnt, 2) = arrSht1(Cnt, 2) Next Cnt Rem 3 main loop ' == Start main loop ========== For Cnt = 1 To UBound(arrSht2(), 1) - 1 Step 1 ' Counting at each row Dim DifCnt As Long 'Count of different cells ' Condition check If (arrSht2(Cnt, 1) <> arrSht1b(Cnt, 1) Or arrSht2(Cnt, 2) <> arrSht1b(Cnt, 2)) And (arrSht2(Cnt + 1, 1) = arrSht1b(Cnt + 1, 1) And arrSht2(Cnt + 1, 2) = arrSht1b(Cnt + 1, 2)) Then ' condition for changed row but next row is as previous : row had data changed, but a row was not inserted Let arrSht1b(Cnt, 1) = arrSht2(Cnt, 1): arrSht1b(Cnt, 2) = arrSht2(Cnt, 2) 'change any changed cell If arrSht1b(Cnt, 1) <> arrSht1(Cnt, 1) Then Let arrOut(Cnt, 1) = arrSht1b(Cnt, 1) & " <> " & arrSht1(Cnt, 1) Let DifCnt = DifCnt + 1 Else: End If If arrSht1b(Cnt, 2) <> arrSht1(Cnt, 2) Then Let arrOut(Cnt, 2) = arrSht1b(Cnt, 2) & " <> " & arrSht1(Cnt, 2) Let DifCnt = DifCnt + 1 Else: End If ' Condition check ElseIf ((arrSht2(Cnt, 1) <> arrSht1b(Cnt, 1) Or arrSht2(Cnt, 2) <> arrSht1b(Cnt, 2)) And (arrSht2(Cnt + 1, 1) <> arrSht1b(Cnt + 1, 1) Or arrSht2(Cnt + 1, 2) <> arrSht1b(Cnt + 1, 2))) Then ' main condition suggesting added new row Dim AdedRows As Long: Let AdedRows = AdedRows + 1 '3b we need to shift all data down to allow space for new row in arrSht2() Dim CntIn As Long For CntIn = (UBound(arrSht2(), 1) - 1) To Cnt Step -1 'loop for all but last from this row Let arrSht1b(CntIn + 1, 1) = arrSht1b(CntIn, 1): arrSht1b(CntIn + 1, 2) = arrSht1b(CntIn, 2) ' This effectively pulls up each row by one Next CntIn '3c add the new data to the modified array, Let arrSht1b() Let arrSht1b(Cnt, 1) = arrSht2(Cnt, 1): arrSht1b(Cnt, 2) = arrSht2(Cnt, 2) If arrSht1b(Cnt, 1) = "" Then arrSht1b(Cnt, 1) = " " ' Just to make final output more neat If arrSht1b(Cnt, 2) = "" Then arrSht1b(Cnt, 2) = " " '3d add info to the output array If Cnt > UBound(arrSht1(), 1) Then ' case of new lines Let arrOut(Cnt, 1) = "An new extra line contains " & arrSht1b(Cnt, 1): arrOut(Cnt, 2) = "An new extra line contains " & arrSht1b(Cnt, 2) Else If arrSht1b(Cnt, 1) <> arrSht1(Cnt, 1) Then Let arrOut(Cnt, 1) = arrSht1b(Cnt, 1) & " <> " & arrSht1(Cnt, 1) Let DifCnt = DifCnt + 1 Else: End If If arrSht1b(Cnt, 2) <> arrSht1(Cnt, 2) Then Let arrOut(Cnt, 2) = arrSht1b(Cnt, 2) & " <> " & arrSht1(Cnt, 2) Let DifCnt = DifCnt + 1 Else: End If End If ' Let Cnt = Cnt + 1 ' we need to skip the next row as that was just effectively added so we are done with it Else ' row has not been added here End If Next Cnt ' ========= End main loop ========== Rem 4 last row may be new If arrSht2(lr2, 1) <> arrSht1(Lr1, 1) Or arrSht2(lr2, 2) <> arrSht1(Lr1, 2) Then ' either cell in last row is different If arrSht2(lr2, 1) <> arrSht1(Lr1, 1) Then Let arrOut(lr2, 1) = arrSht2(lr2, 1) & " on last row is new" Let DifCnt = DifCnt + 1 Else: End If If arrSht2(lr2, 2) <> arrSht1(Lr1, 2) Then Let arrOut(lr2, 2) = arrSht2(lr2, 2) & " on last row is new" Let DifCnt = DifCnt + 1 Else: End If Else 'last row on sheet2 is as on sheet1 End If Rem 5 Output in new file For testing purposes, I give the output in a third worksheet, Tabelle3 Dim Ws3 As Worksheet: Set Ws3 = ThisWorkbook.Worksheets("Tabelle3") Ws3.Cells.ClearContents Let Ws3.Range("A1:B1").Value = "Sheet1": Ws3.Range("C1:D1").Value = "Test Output": Ws3.Range("E1:F1").Value = "Sheet2" Let Ws3.Range("A2").Resize(UBound(arrSht1(), 1), UBound(arrSht1(), 2)).Value = arrSht1() Let Ws3.Range("C2").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2)).Value = arrOut() Let Ws3.Range("E2").Resize(UBound(arrSht2(), 1), UBound(arrSht2(), 2)).Value = arrSht2() Ws3.Columns.AutoFit Rem 6 MsgBoox output MsgBox Prompt:="inserted lines is " & AdedRows & vbCrLf & "Changed cells is " & DifCnt End Sub

Test runs from code

Code:

Sub TestyCalls() ' http://www.excelfox.com/forum/showthread.php/2277-Vba-button-Comparison-data-between-two-file-or-two-tabs?p=10741#post10741 ' Call Testie(Worksheets("Sheet1"), Worksheets("Sheet2")) Call Testy(Worksheets("Sheet1"), Worksheets("Sheet2")) End Sub

For support of this excelfox Thread:
http://www.excelfox.com/forum/showth...0741#post10741

Using Excel 2007 32 bit

Sheet1 Sheet1 Test Output Test Output Sheet2 Sheet2

Customer Assembly Customer Assembly

Nu Torque
13456
Nu Torque
13456

Blu Origin Spaceship Blu Origin Spaceship

Jet Blue21 ABC

Alaska
789

Toyota Supra

Emirate ABC12345

Jet Blue21 ABC

Alaska
789

Toyota Supra

Emirate ABC12345

Dup 2 of Toyota Dup 2 of Supra Toyota Supra

Dup 2 of Emirate Dup 2 of ABC12345 Emirate ABC12345

Spaceship 12 Spaceship
12

Worksheet: Tabelle3

Using Excel 2007 32 bit

Sheet1 Sheet1 Test Output Test Output Sheet2 Sheet2

Customer Assembly Customer Assembly

Nu Torque
13456
Nu Torque
13456

Blu Origin Spaceship Alaska
789

Jet Blue21 ABC Excel123 HiThai Excel123 HiThai

Alaska
789
Blu Origin Spaceship

Toyota Supra Emirate ABC12345

Emirate ABC12345 Jet Blue21 ABC

Toyota Supra

Worksheet: Tabelle3

1 Attachment(s)

Code in support of this Post
http://www.excelfox.com/forum/showth...0741#post10741

Code:

Sub TestyCalls() ' http://www.excelfox.com/forum/showthread.php/2277-Vba-button-Comparison-data-between-two-file-or-two-tabs?p=10741#post10741 ' Call Testie(Worksheets("Sheet1"), Worksheets("Sheet2")) Call Testy(Worksheets("Sheet1"), Worksheets("Sheet2")) End Sub Sub Testy(Ws1 As Worksheet, Ws2 As Worksheet) Rem 1 Worksheet data info '1a capture data '1a(i) last data rows Dim lr1_1 As Long, Lr1_2 As Long, Lr2_1 As Long, Lr2_2 As Long, Lr1 As Long, lr2 As Long Let lr1_1 = Ws1.Cells(Rows.Count, 1).End(xlUp).row Let Lr1_2 = Ws1.Cells(Rows.Count, 2).End(xlUp).row: Lr2_1 = Ws2.Cells(Rows.Count, 1).End(xlUp).row: Lr2_2 = Ws2.Cells(Rows.Count, 2).End(xlUp).row If lr1_1 > Lr1_2 Then Let Lr1 = lr1_1 Else Let Lr1 = Lr1_2 End If Let lr2 = Lr2_2: If Lr2_1 > Lr2_2 Then Let lr2 = Lr2_1 '1a(ii) capture data into arrays in one go Dim arrSht1() As Variant, arrSht2() As Variant Let arrSht1() = Ws1.Range("A1:B" & Lr1 & "").Value Let arrSht2() = Ws2.Range("A1:B" & lr2 & "").Value Rem 2 arrays for check and output Dim arrSht1b() As String, arrOut() As String, arrSht1Chk() As String, arrSht2Chk() As String '2a size arrays to that of sheet 2 data ' ReDim arrSht1b(1 To UBound(arrSht2(), 1), 1 To UBound(arrSht2(), 2)) ReDim arrOut(1 To UBound(arrSht2(), 1), 1 To UBound(arrSht2(), 2)) ReDim arrSht1Chk(1 To UBound(arrSht1(), 1)): ReDim arrSht2Chk(1 To UBound(arrSht2(), 1)) ' Arrays for concatenated data '2b make check arrays fill modified sheet 1 array, arrSht1b() , initially with sheet 1 data Dim Cnt As Long For Cnt = 1 To UBound(arrSht1(), 1) Step 1 ' Let arrSht1b(Cnt, 1) = arrSht1(Cnt, 1): Let arrSht1b(Cnt, 2) = arrSht1(Cnt, 2) Let arrSht1Chk(Cnt) = arrSht1(Cnt, 1) & "|" & arrSht1(Cnt, 2) Next Cnt For Cnt = 1 To UBound(arrSht2(), 1) Step 1 Let arrSht2Chk(Cnt) = arrSht2(Cnt, 1) & "|" & arrSht2(Cnt, 2) Next Cnt '2c make contents of array for output initially all dat from Sheet2 For Cnt = 1 To UBound(arrSht2(), 1) Step 1 Let arrOut(Cnt, 1) = CStr(arrSht2(Cnt, 1)): arrOut(Cnt, 2) = CStr(arrSht2(Cnt, 2)) Next Cnt Rem 3 main loop ' == Start Main loop ================ For Cnt = 1 To UBound(arrSht1(), 1) Step 1 ' Counting at each row of Sheet2 Dim MtchRes As Variant Let MtchRes = Application.Match(arrSht1Chk(Cnt), arrSht2Chk(), 0) '3a action whilst match is found --Inner Loop------ Do While Not IsError(MtchRes) ' The 3a Loop Dim DupyCnt As Long: Let DupyCnt = DupyCnt + 1 If DupyCnt > 1 Then Let arrOut(MtchRes, 1) = "Dup " & DupyCnt & " of " & arrOut(MtchRes, 1): arrOut(MtchRes, 2) = "Dup " & DupyCnt & " of " & arrOut(MtchRes, 2) Else Let arrOut(MtchRes, 1) = "": arrOut(MtchRes, 2) = "" ' remove the found data from array for output so that next line can look again for a possible duplicate End If Let arrSht2Chk(MtchRes) = "" ' remove entry in check array so that next line can look for possible duplicate Let MtchRes = Application.Match(arrSht1Chk(Cnt), arrSht2Chk(), 0) Loop ' ---------------------------------------- Let DupyCnt = 0 ' reset the Duplicated data count for next row of data in Sheet1 Next Cnt ' ========= End main loop ================= effectively we go to next row of data in Sheet1 with this line Rem 5 Output in new file For testing purposes, I give the output in a third worksheet, Tabelle3 Dim Ws3 As Worksheet: Set Ws3 = ThisWorkbook.Worksheets("Tabelle3") Ws3.Cells.ClearContents Let Ws3.Range("A1:B1").Value = "Sheet1": Ws3.Range("C1:D1").Value = "Test Output": Ws3.Range("E1:F1").Value = "Sheet2" Let Ws3.Range("A2").Resize(UBound(arrSht1(), 1), UBound(arrSht1(), 2)).Value = arrSht1() Let Ws3.Range("C2").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2)).Value = arrOut() Let Ws3.Range("E2").Resize(UBound(arrSht2(), 1), UBound(arrSht2(), 2)).Value = arrSht2() Ws3.Columns.AutoFit Rem 6 MsgBox output ' MsgBox Prompt:="Inserted lines is " & AdedRows & vbCrLf & "Changed cells is " & DifCnt End Sub

1 Attachment(s)

Code in support of this Post
http://www.excelfox.com/forum/showth...0745#post10745

Code:

Option Explicit Sub TestyCalls() ' http://www.excelfox.com/forum/showth...0741#post10741 ' Call Testie(Worksheets("Sheet1"), Worksheets("Sheet2")) Call Testy(Worksheets("Sheet1"), Worksheets("Sheet2")) End Sub Sub Testy(Ws1 As Worksheet, Ws2 As Worksheet) Rem 1 Worksheet data info '1a capture data '1a(i) last data rows Dim lr1_1 As Long, Lr1_2 As Long, Lr2_1 As Long, Lr2_2 As Long, Lr1 As Long, lr2 As Long Let lr1_1 = Ws1.Cells(Rows.Count, 1).End(xlUp).row Let Lr1_2 = Ws1.Cells(Rows.Count, 2).End(xlUp).row: Lr2_1 = Ws2.Cells(Rows.Count, 1).End(xlUp).row: Lr2_2 = Ws2.Cells(Rows.Count, 2).End(xlUp).row If lr1_1 > Lr1_2 Then Let Lr1 = lr1_1 Else Let Lr1 = Lr1_2 End If Let lr2 = Lr2_2: If Lr2_1 > Lr2_2 Then Let lr2 = Lr2_1 '1a(ii) capture data into arrays in one go Dim arrSht1() As Variant, arrSht2() As Variant Let arrSht1() = Ws1.Range("A1:B" & Lr1 & "").Value Let arrSht2() = Ws2.Range("A1:B" & lr2 & "").Value Rem 2 arrays for check and output Dim arrSht1b() As String, arrOut() As String, arrSht1Chk() As String, arrSht2Chk() As String, arrSht2ChkKopie() As String '2a size arrays to that of sheet 2 data ' ReDim arrSht1b(1 To UBound(arrSht2(), 1), 1 To UBound(arrSht2(), 2)) ReDim arrOut(1 To UBound(arrSht2(), 1), 1 To UBound(arrSht2(), 2)) ReDim arrSht1Chk(1 To UBound(arrSht1(), 1)) ReDim arrSht2Chk(1 To UBound(arrSht2(), 1)) ReDim arrSht2ChkKopie(1 To UBound(arrSht2(), 1)) '2b make check arrays fill modified sheet 1 array, arrSht1b() , initially with sheet 1 data Dim Cnt As Long For Cnt = 1 To UBound(arrSht1(), 1) Step 1 ' Let arrSht1b(Cnt, 1) = arrSht1(Cnt, 1): Let arrSht1b(Cnt, 2) = arrSht1(Cnt, 2) Let arrSht1Chk(Cnt) = arrSht1(Cnt, 1) & "|" & arrSht1(Cnt, 2) Next Cnt For Cnt = 1 To UBound(arrSht2(), 1) Step 1 Let arrSht2Chk(Cnt) = arrSht2(Cnt, 1) & "|" & arrSht2(Cnt, 2) Next Cnt Let arrSht2ChkKopie() = arrSht2Chk() ' Arrays of same size and type can be assiigned too eachother '2c make contents of array for output initially all dat from Sheet2 For Cnt = 1 To UBound(arrSht2(), 1) Step 1 Let arrOut(Cnt, 1) = CStr(arrSht2(Cnt, 1)): arrOut(Cnt, 2) = CStr(arrSht2(Cnt, 2)) Next Cnt Rem 3 main loop ' == Start Main loop ================ For Cnt = 1 To UBound(arrSht1(), 1) Step 1 ' Counting at each row of Sheet2 Dim MtchRes As Variant Let MtchRes = Application.Match(arrSht1Chk(Cnt), arrSht2Chk(), 0) ' If IsError(MtchRes) Then ' case data is missing Sheet2 ( deleted ) ' This straight forward modification to the existing code will not work. This is because the code modifies the check array , arrSht2Chk() , when checking for the data from sheet1 in sheet2 ' Let arrOut(Cnt, 1) = "Missing: " & arrSht1(Cnt, 1): arrOut(Cnt, 2) = "Missing: " & arrSht1(Cnt, 2) ' Else: '3a(ii) action whilst match is found --Inner Loop------ Do While Not IsError(MtchRes) ' The 3a Loop Dim DupyCnt As Long: Let DupyCnt = DupyCnt + 1 If DupyCnt > 1 Then Let arrOut(MtchRes, 1) = "Dup " & DupyCnt & " of " & arrOut(MtchRes, 1): arrOut(MtchRes, 2) = "Dup " & DupyCnt & " of " & arrOut(MtchRes, 2) Else Let arrOut(MtchRes, 1) = "": arrOut(MtchRes, 2) = "" ' remove the found data from array for output so that next line can look again for a possible duplicate End If Let arrSht2Chk(MtchRes) = "" ' remove entry in check array so that next line can look for possible duplicate Let MtchRes = Application.Match(arrSht1Chk(Cnt), arrSht2Chk(), 0) Loop ' ---------------------------------------- ' End If ' Let DupyCnt = 0 ' reset the Duplicated data count for next row of data in Sheet1 Next Cnt ' ========= End Main loop ================= effectively we go to next row of data in Sheet1 with this line Rem 3b Second Loop ' ##### Start Second loop ##### For Cnt = 1 To UBound(arrSht1(), 1) Step 1 ' Counting at each row of Sheet2 'Dim MtchRes As Variant Let MtchRes = Application.Match(arrSht1Chk(Cnt), arrSht2ChkKopie, 0) If IsError(MtchRes) Then ' case data is missing Sheet2 ( deleted ) Let arrOut(Cnt, 1) = "Missing: " & arrSht1(Cnt, 1): arrOut(Cnt, 2) = "Missing: " & arrSht1(Cnt, 2) Else End If ' Let DupyCnt = 0 ' reset the Duplicated data count for next row of data in Sheet1 Next Cnt ' ##### End Second Loop ################# effectively we go to next row of data in Sheet1 with this line Rem 5 Output in new file For testing purposes, I give the output in a third worksheet, Tabelle3 Dim Ws3 As Worksheet: Set Ws3 = ThisWorkbook.Worksheets("Tabelle3") Ws3.Cells.ClearContents Let Ws3.Range("A1:B1").Value = "Sheet1": Ws3.Range("C1:D1").Value = "Test Output": Ws3.Range("E1:F1").Value = "Sheet2" Let Ws3.Range("A2").Resize(UBound(arrSht1(), 1), UBound(arrSht1(), 2)).Value = arrSht1() Let Ws3.Range("C2").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2)).Value = arrOut() Let Ws3.Range("E2").Resize(UBound(arrSht2(), 1), UBound(arrSht2(), 2)).Value = arrSht2() Ws3.Columns.AutoFit Rem 6 MsgBox output ' MsgBox Prompt:="Inserted lines is " & AdedRows & vbCrLf & "Changed cells is " & DifCnt End Sub

Code in support of this Post
http://www.excelfox.com/forum/showth...0745#post10745

Using Excel 2007 32 bit

_Row\^Col
A

B

C

D

E

F

1
Sheet1 Sheet1 Test Output Test Output Sheet2 Sheet2

2
Customer Assembly Customer Assembly

3
Nu Torque
13456
Nu Torque
13456

4
Blu Origin Spaceship Alaska
789

5
Jet Blue21 ABC Excel123 HiThai Excel123 HiThai

6
Alaska
789
Blu Origin Spaceship

7
Toyota Supra Missing: Toyota Missing: Supra Emirate ABC12345

8
Emirate ABC12345 Jet Blue21 ABC

9

Worksheet: Tabelle3

_Row\^Col	A	B	C	D	E	F
1	Sheet1	Sheet1	Test Output	Test Output	Sheet2	Sheet2
2	Customer	Assembly			Customer	Assembly
3	Nu Torque	13456			Nu Torque	13456
4	Blu Origin	Spaceship			Alaska	789
5	Jet Blue21	ABC	Excel123	HiThai	Excel123	HiThai
6	Alaska	789			Blu Origin	Spaceship
7	Toyota	Supra	Missing: Toyota	Missing: Supra	Emirate	ABC12345
8	Emirate	ABC12345			Jet Blue21	ABC
9

Results in support of answer to this post
http://www.excelfox.com/forum/showth...0749#post10749
( note a typo in your data for row 9 ( correspondingly output row 10 in these screenshots) : Angle is not Angel . hence this is taken by my code as Missing data row )

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
Original Original Original Original Original Original Test Output Test Output Test Output Test Output Test Output NEW NEW NEW NEW NEW NEW

2
Assembly #: Assembly Name: Assembly Name: Assembly #: Assembly Name:

3
Qty Per Ref/Designator Description Customer PN Internal PN Manufacture PN Customer PN Internal PN Manufacture PN Qty Per Ref/Designator Description Customer PN Internal PN Manufacture PN

4

1
Nu Torque
13456

456

456
13456 456 456
1
Nu Torque
13456

456

456

5

1
Blu Origin Spaceship
457

457
Spaceship 457 457
1
Blu Origin Spaceship
457

457

6

2
Jet Blue21 ABC
458

458
ABC 458 458
2
Jet Blue21 ABC
458

458

7

3
EXCELL123
123
ABC ABC MISSING: 3 MISSING: EXCELL123 MISSING: 123 MISSING: ABC MISSING: ABC
3
Alaska
789

459

459

8

3
Toyota Supra
460

460
Supra 460 460
3
Toyota Supra
460

460

9

2
Emirate ABC12345
461

461
ABC12345 461 461
2
Emirate ABC12345
461

461

10

1
Angel ABC12346
462

462
MISSING: 1 MISSING: Angel MISSING: ABC12346 MISSING: 462 MISSING: 462
1
Angle ABC12346
462

462

Worksheet: Result

Using Excel 2007 32 bit

Original Original Original Original Original Original Test Output Test Output Test Output Test Output Test Output NEW NEW NEW NEW NEW NEW

Assembly #: Assembly Name: Assembly Name: Assembly #: Assembly Name:

Qty Per Ref/Designator Description Customer PN Internal PN Manufacture PN Customer PN Internal PN Manufacture PN Qty Per Ref/Designator Description Customer PN Internal PN Manufacture PN

1
Nu Torque
13456

456

456
13456 456 456
1
Nu Torque
13456

456

456

1
Blu Origin Spaceship
457

457
Spaceship 457 457
1
Blu Origin Spaceship
457

457

2
Jet Blue21 ABC
458

458
ABC 458 458
2
Jet Blue21 ABC
458

458

3
EXCELL123
123
ABC ABC MISSING: 3 MISSING: EXCELL123 MISSING: 123 MISSING: ABC MISSING: ABC
3
Alaska
789

459

459

3
Toyota Supra
460

460
Supra 460 460
3
Toyota Supra
460

460

2
Emirate ABC12345
461

461
ABC12345 461 461
2
Emirate ABC12345
461

461

1
Angel ABC12346
462

462
MISSING: 1 MISSING: Angel MISSING: ABC12346 MISSING: 462 MISSING: 462
1
Angle ABC12346
462

462

Worksheet: Result

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1	Original	Original	Original	Original	Original	Original	Test Output	Test Output	Test Output	Test Output	Test Output	NEW	NEW	NEW	NEW	NEW	NEW
2			Assembly #:			Assembly Name:					Assembly Name:			Assembly #:			Assembly Name:
3	Qty Per	Ref/Designator	Description	Customer PN	Internal PN	Manufacture PN			Customer PN	Internal PN	Manufacture PN	Qty Per	Ref/Designator	Description	Customer PN	Internal PN	Manufacture PN
4	1	Nu Torque		13456	456	456			13456	456	456	1	Nu Torque		13456	456	456
5	1	Blu Origin		Spaceship	457	457			Spaceship	457	457	1	Blu Origin		Spaceship	457	457
6	2	Jet Blue21		ABC	458	458			ABC	458	458	2	Jet Blue21		ABC	458	458
7	3	EXCELL123		123	ABC	ABC	MISSING: 3	MISSING: EXCELL123	MISSING: 123	MISSING: ABC	MISSING: ABC	3	Alaska		789	459	459
8	3	Toyota		Supra	460	460			Supra	460	460	3	Toyota		Supra	460	460
9	2	Emirate		ABC12345	461	461			ABC12345	461	461	2	Emirate		ABC12345	461	461
10	1	Angel		ABC12346	462	462	MISSING: 1	MISSING: Angel	MISSING: ABC12346	MISSING: 462	MISSING: 462	1	Angle		ABC12346	462	462

1 Attachment(s)

Code corresponding to last post, in support of answer to this post
http://www.excelfox.com/forum/showth...0749#post10749

Code:

Sub TestyCalls() ' http://www.excelfox.com/forum/showthread.php/2277-Vba-button-Comparison-data-between-two-file-or-two-tabs?p=10741#post10741 ' Call Testie(Worksheets("Original"), Worksheets("NEW")) ' Call Testy(Worksheets("Original"), Worksheets("NEW")) Call Testies(Worksheets("Original"), Worksheets("NEW")) End Sub Sub Testies(Ws1 As Worksheet, Ws2 As Worksheet) Rem 1 Worksheet data info '1a capture data '1a(i) last data rows Dim lr1_1 As Long, Lr1_2 As Long, Lr2_1 As Long, Lr2_2 As Long, Lr1 As Long, lr2 As Long Let lr1_1 = Ws1.Cells(Rows.Count, 1).End(xlUp).row Let Lr1_2 = Ws1.Cells(Rows.Count, 2).End(xlUp).row: Lr2_1 = Ws2.Cells(Rows.Count, 1).End(xlUp).row: Lr2_2 = Ws2.Cells(Rows.Count, 2).End(xlUp).row If lr1_1 > Lr1_2 Then Let Lr1 = lr1_1 Else Let Lr1 = Lr1_2 End If Let lr2 = Lr2_2: If Lr2_1 > Lr2_2 Then Let lr2 = Lr2_1 '1a(ii) capture data into arrays in one go Dim arrSht1() As Variant, arrSht2() As Variant Let arrSht1() = Ws1.Range("B1:G" & Lr1 & "").Value Let arrSht2() = Ws2.Range("B1:G" & Lr1 & "").Value Rem 2 arrays for check and output Dim arrSht1b() As String, arrOut() As String, arrSht1Chk() As String, arrSht2Chk() As String, arrSht2ChkKopie() As String '2a size arrays to that of sheet 2 data ' ReDim arrSht1b(1 To UBound(arrSht2(), 1), 1 To UBound(arrSht2(), 2)) ReDim arrOut(1 To UBound(arrSht2(), 1), 1 To UBound(arrSht2(), 2) - 1) ' -1 as one column , D is not required ReDim arrSht1Chk(1 To UBound(arrSht1(), 1)) ReDim arrSht2Chk(1 To UBound(arrSht2(), 1)) ReDim arrSht2ChkKopie(1 To UBound(arrSht2(), 1)) '2b make check arrays fill modified sheet 1 array, arrSht1b() , initially with sheet 1 data Dim Cnt As Long For Cnt = 1 To UBound(arrSht1(), 1) Step 1 ' Let arrSht1b(Cnt, 1) = arrSht1(Cnt, 1): Let arrSht1b(Cnt, 2) = arrSht1(Cnt, 2) ' Let arrSht1Chk(Cnt) = arrSht1(Cnt, 1) & "|" & arrSht1(Cnt, 2) Let arrSht1Chk(Cnt) = arrSht1(Cnt, 1) & "|" & arrSht1(Cnt, 2) & "|" & arrSht1(Cnt, 4) & "|" & arrSht1(Cnt, 5) & "|" & arrSht1(Cnt, 6) Next Cnt For Cnt = 1 To UBound(arrSht2(), 1) Step 1 ' Let arrSht2Chk(Cnt) = arrSht2(Cnt, 1) & "|" & arrSht2(Cnt, 2) Let arrSht2Chk(Cnt) = arrSht2(Cnt, 1) & "|" & arrSht2(Cnt, 2) & "|" & arrSht2(Cnt, 4) & "|" & arrSht2(Cnt, 5) & "|" & arrSht2(Cnt, 6) Next Cnt Let arrSht2ChkKopie() = arrSht2Chk() ' Arrays of same size and type can be assiigned too eachother '2c make contents of array for output initially all dat from NEW For Cnt = 1 To UBound(arrSht2(), 1) Step 1 Let arrOut(Cnt, 1) = CStr(arrSht2(Cnt, 1)): arrOut(Cnt, 2) = CStr(arrSht2(Cnt, 2)): arrOut(Cnt, 3) = CStr(arrSht2(Cnt, 4)):: arrOut(Cnt, 4) = CStr(arrSht2(Cnt, 5)):: arrOut(Cnt, 5) = CStr(arrSht2(Cnt, 6)) Next Cnt Rem 3 main loop ' == Start Main loop ================ For Cnt = 1 To UBound(arrSht1(), 1) Step 1 ' Counting at each row of NEW Dim MtchRes As Variant Let MtchRes = Application.Match(arrSht1Chk(Cnt), arrSht2Chk(), 0) ' If IsError(MtchRes) Then ' case data is MISSING: NEW ( MISSING: ) ' This straight forward modification to the existing code will not work. This is because the code modifies the check array , arrSht2Chk() , when checking for the data from Original in NEW ' Let arrOut(Cnt, 1) = "Missing: " & arrSht1(Cnt, 1): arrOut(Cnt, 2) = "MISSING:: " & arrSht1(Cnt, 2) ' Else: '3a(ii) action whilst match is found --Inner Loop------ Do While Not IsError(MtchRes) ' The 3a Loop Dim DupyCnt As Long: Let DupyCnt = DupyCnt + 1 If DupyCnt > 1 Then Let arrOut(MtchRes, 1) = "Dup " & DupyCnt & " of " & arrOut(MtchRes, 1): arrOut(MtchRes, 2) = "Dup " & DupyCnt & " of " & arrOut(MtchRes, 2) Else Let arrOut(MtchRes, 1) = "": arrOut(MtchRes, 2) = "" ' remove the found data from array for output so that next line can look again for a possible duplicate End If Let arrSht2Chk(MtchRes) = "" ' remove entry in check array so that next line can look for possible duplicate Let MtchRes = Application.Match(arrSht1Chk(Cnt), arrSht2Chk(), 0) Loop ' ---------------------------------------- ' End If ' Let DupyCnt = 0 ' reset the Duplicated data count for next row of data in Original Next Cnt ' ========= End Main loop ================= effectively we go to next row of data in Original with this line Rem 3b Second Loop ' ##### Start Second loop ##### For Cnt = 1 To UBound(arrSht1(), 1) Step 1 ' Counting at each row of NEW 'Dim MtchRes As Variant Let MtchRes = Application.Match(arrSht1Chk(Cnt), arrSht2ChkKopie, 0) If IsError(MtchRes) Then ' case data is missing NEW ( MISSING: ) Let arrOut(Cnt, 1) = "MISSING: " & arrSht1(Cnt, 1): arrOut(Cnt, 2) = "MISSING: " & arrSht1(Cnt, 2): arrOut(Cnt, 3) = "MISSING: " & arrSht1(Cnt, 4): arrOut(Cnt, 4) = "MISSING: " & arrSht1(Cnt, 5): arrOut(Cnt, 5) = "MISSING: " & arrSht1(Cnt, 6) Else End If ' Let DupyCnt = 0 ' reset the Duplicated data count for next row of data in Original Next Cnt ' ##### End Second Loop ################# effectively we go to next row of data in Original with this line Rem 5 Output in new file For testing purposes, I give the output in a third worksheet, Tabelle3 Dim Ws3 As Worksheet: Set Ws3 = ThisWorkbook.Worksheets("Result") Ws3.Cells.ClearContents Let Ws3.Range("A1:F1").Value = "Original": Ws3.Range("G1:K1").Value = "Test Output": Ws3.Range("L1:Q1").Value = "NEW" Let Ws3.Range("A2").Resize(UBound(arrSht1(), 1), UBound(arrSht1(), 2)).Value = arrSht1() Let Ws3.Range("G2").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2)).Value = arrOut() Let Ws3.Range("L2").Resize(UBound(arrSht2(), 1), UBound(arrSht2(), 2)).Value = arrSht2() Ws3.Columns.AutoFit Rem 6 MsgBox output ' MsgBox Prompt:="Inserted lines is " & AdedRows & vbCrLf & "Changed cells is " & DifCnt End Sub

Suggested test data to answer this post: http://www.excelfox.com/forum/showth...0754#post10754

Using Excel 2007 32 bit

_Row\^Col
A

B

C

D

E

F

G

1
Customer: Assembly #: Assembly Name:

2
# Qty Per Ref/Designator Description Customer PN Internal PN Manufacture PN

3

1

1

Nu Torque

13456

456

456

4

2

1

Blu Origin

Spaceship

457

457

5

3

2

Jet Blue21

ABC

458

458

6

4

3

EXCELL123

123

ABC

ABC

7

5

3

Toyota

Supra

460

460

8

6

2

Emirate

ABC12345

461

461

9

7

1

Angel

ABC12346

462

462

Worksheet: Original

Using Excel 2007 32 bit

_Row\^Col
A

B

C

D

E

F

G

1
Customer: Assembly #: Assembly Name:

2
# Qty Per Ref/Designator Description Customer PN Internal PN Manufacture PN

3

1

1

Nu Torque

13456

456

456

4

2

1

Blu Origin

Spaceship

457

457

5

3

2

Jet Blue23

ABC

DEF

DEF

6

4

3

EXCELL123

123

ABC

ABC

7

5

3

Toyota

Supra

460

460

8

6

2

Emirate

ABC12345

461

461

9

3

2

Jet Blue21

ABC

458

458

Worksheet: NEW

_Row\^Col	A	B	C	D	E	F	G
1	Customer:			Assembly #:			Assembly Name:
2	#	Qty Per	Ref/Designator	Description	Customer PN	Internal PN	Manufacture PN
3	1	1	Nu Torque		13456	456	456
4	2	1	Blu Origin		Spaceship	457	457
5	3	2	Jet Blue21		ABC	458	458
6	4	3	EXCELL123		123	ABC	ABC
7	5	3	Toyota		Supra	460	460
8	6	2	Emirate		ABC12345	461	461
9	7	1	Angel		ABC12346	462	462

_Row\^Col	A	B	C	D	E	F	G
1	Customer:			Assembly #:			Assembly Name:
2	#	Qty Per	Ref/Designator	Description	Customer PN	Internal PN	Manufacture PN
3	1	1	Nu Torque		13456	456	456
4	2	1	Blu Origin		Spaceship	457	457
5	3	2	Jet Blue23		ABC	DEF	DEF
6	4	3	EXCELL123		123	ABC	ABC
7	5	3	Toyota		Supra	460	460
8	6	2	Emirate		ABC12345	461	461
9	3	2	Jet Blue21		ABC	458	458

In the last code , ( Sub Testies ), the following output is obtained when using the suggested test data above ( http://www.excelfox.com/forum/showth...0756#post10756 ) :

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
Original Original Original Original Original Original Test Output Test Output Test Output Test Output Test Output NEW NEW NEW NEW NEW NEW

2
Assembly #: Assembly Name: Assembly #: Assembly Name:

3
Qty Per Ref/Designator Description Customer PN Internal PN Manufacture PN Qty Per Ref/Designator Description Customer PN Internal PN Manufacture PN

4

1
Nu Torque
13456

456

456

1
Nu Torque
13456

456

456

5

1
Blu Origin Spaceship
457

457

1
Blu Origin Spaceship
457

457

6

2
Jet Blue21 ABC
458

458
2 Jet Blue23 ABC DEF DEF
2
Jet Blue23 ABC DEF DEF

7

3
EXCELL123
123
ABC ABC
3
EXCELL123
123
ABC ABC

8

3
Toyota Supra
460

460

3
Toyota Supra
460

460

9

2
Emirate ABC12345
461

461

2
Emirate ABC12345
461

461

10

1
Angel ABC12346
462

462
MISSING: 1 MISSING: Angel MISSING: ABC12346 MISSING: 462 MISSING: 462
2
Jet Blue21 ABC
458

458

Worksheet: Result

Using Excel 2007 32 bit

_Row\^Col
G

H

I

J

K

1
Test Output Test Output Test Output Test Output Test Output

2

3

4

5

6
2 Jet Blue23 ABC DEF DEF

7

8

9

10
MISSING: 1 MISSING: Angel MISSING: ABC12346 MISSING: 462 MISSING: 462

Worksheet: Result

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
Original Original Original Original Original Original Test Output Test Output Test Output Test Output Test Output NEW NEW NEW NEW NEW NEW

6

2
Jet Blue21 ABC
458

458
2 Jet Blue23 ABC DEF DEF
2
Jet Blue23 ABC DEF DEF

Worksheet: Result

_._____________________________________-

We have currently output like this:

Test Output Test Output Test Output Test Output Test Output

2 Jet Blue23 ABC DEF DEF

But We want this to look more similar to screenshot output from post #15 ( http://www.excelfox.com/forum/showth...0754#post10754 )

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1	Original	Original	Original	Original	Original	Original	Test Output	Test Output	Test Output	Test Output	Test Output	NEW	NEW	NEW	NEW	NEW	NEW
2			Assembly #:			Assembly Name:								Assembly #:			Assembly Name:
3	Qty Per	Ref/Designator	Description	Customer PN	Internal PN	Manufacture PN						Qty Per	Ref/Designator	Description	Customer PN	Internal PN	Manufacture PN
4	1	Nu Torque		13456	456	456						1	Nu Torque		13456	456	456
5	1	Blu Origin		Spaceship	457	457						1	Blu Origin		Spaceship	457	457
6	2	Jet Blue21		ABC	458	458	2	Jet Blue23	ABC	DEF	DEF	2	Jet Blue23		ABC	DEF	DEF
7	3	EXCELL123		123	ABC	ABC						3	EXCELL123		123	ABC	ABC
8	3	Toyota		Supra	460	460						3	Toyota		Supra	460	460
9	2	Emirate		ABC12345	461	461						2	Emirate		ABC12345	461	461
10	1	Angel		ABC12346	462	462	MISSING: 1	MISSING: Angel	MISSING: ABC12346	MISSING: 462	MISSING: 462	2	Jet Blue21		ABC	458	458

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1	Original	Original	Original	Original	Original	Original	Test Output	Test Output	Test Output	Test Output	Test Output	NEW	NEW	NEW	NEW	NEW	NEW
6	2	Jet Blue21		ABC	458	458	2	Jet Blue23	ABC	DEF	DEF	2	Jet Blue23		ABC	DEF	DEF

1 Attachment(s)

Code to answer this post: http://www.excelfox.com/forum/showth...0754#post10754

Code:

Sub TestyCalls() ' http://www.excelfox.com/forum/showthread.php/2277-Vba-button-Comparison-data-between-two-file-or-two-tabs?p=10741#post10741 ' Call Testie(Worksheets("Original"), Worksheets("NEW")) ' Call Testy(Worksheets("Original"), Worksheets("NEW")) ' Call Testies(Worksheets("Original"), Worksheets("NEW")) Call Tests28July(Worksheets("Original"), Worksheets("NEW")) End Sub Sub Tests28July(Ws1 As Worksheet, Ws2 As Worksheet) Rem 1 Worksheet data info '1a capture data '1a(i) last data rows Dim lr1_1 As Long, Lr1_2 As Long, Lr2_1 As Long, Lr2_2 As Long, Lr1 As Long, lr2 As Long Let lr1_1 = Ws1.Cells(Rows.Count, 1).End(xlUp).row Let Lr1_2 = Ws1.Cells(Rows.Count, 2).End(xlUp).row: Lr2_1 = Ws2.Cells(Rows.Count, 1).End(xlUp).row: Lr2_2 = Ws2.Cells(Rows.Count, 2).End(xlUp).row If lr1_1 > Lr1_2 Then Let Lr1 = lr1_1 Else Let Lr1 = Lr1_2 End If Let lr2 = Lr2_2: If Lr2_1 > Lr2_2 Then Let lr2 = Lr2_1 '1a(ii) capture data into arrays in one go Dim arrSht1() As Variant, arrSht2() As Variant Let arrSht1() = Ws1.Range("B1:G" & Lr1 & "").Value Let arrSht2() = Ws2.Range("B1:G" & Lr1 & "").Value Rem 2 arrays for check and output Dim arrSht1b() As String, arrOut() As String, arrSht1Chk() As String, arrSht2Chk() As String, arrSht2ChkKopie() As String '2a size arrays to that of sheet 2 data ' ReDim arrSht1b(1 To UBound(arrSht2(), 1), 1 To UBound(arrSht2(), 2)) ReDim arrOut(1 To UBound(arrSht2(), 1), 1 To UBound(arrSht2(), 2) - 1) ' -1 as one column , D is not required ReDim arrSht1Chk(1 To UBound(arrSht1(), 1)) ReDim arrSht2Chk(1 To UBound(arrSht2(), 1)) ReDim arrSht2ChkKopie(1 To UBound(arrSht2(), 1)) '2b make check arrays fill modified sheet 1 array, arrSht1b() , initially with sheet 1 data Dim Cnt As Long For Cnt = 1 To UBound(arrSht1(), 1) Step 1 ' Let arrSht1b(Cnt, 1) = arrSht1(Cnt, 1): Let arrSht1b(Cnt, 2) = arrSht1(Cnt, 2) ' Let arrSht1Chk(Cnt) = arrSht1(Cnt, 1) & "|" & arrSht1(Cnt, 2) Let arrSht1Chk(Cnt) = arrSht1(Cnt, 1) & "|" & arrSht1(Cnt, 2) & "|" & arrSht1(Cnt, 4) & "|" & arrSht1(Cnt, 5) & "|" & arrSht1(Cnt, 6) Next Cnt For Cnt = 1 To UBound(arrSht2(), 1) Step 1 ' Let arrSht2Chk(Cnt) = arrSht2(Cnt, 1) & "|" & arrSht2(Cnt, 2) Let arrSht2Chk(Cnt) = arrSht2(Cnt, 1) & "|" & arrSht2(Cnt, 2) & "|" & arrSht2(Cnt, 4) & "|" & arrSht2(Cnt, 5) & "|" & arrSht2(Cnt, 6) Next Cnt Let arrSht2ChkKopie() = arrSht2Chk() ' Arrays of same size and type can be assiigned to eachother '2c make contents of array for output initially all dat from NEW For Cnt = 1 To UBound(arrSht2(), 1) Step 1 Let arrOut(Cnt, 1) = CStr(arrSht2(Cnt, 1)): arrOut(Cnt, 2) = CStr(arrSht2(Cnt, 2)): arrOut(Cnt, 3) = CStr(arrSht2(Cnt, 4)):: arrOut(Cnt, 4) = CStr(arrSht2(Cnt, 5)):: arrOut(Cnt, 5) = CStr(arrSht2(Cnt, 6)) Next Cnt Rem 3 main loop ' == Start Main loop ================ For Cnt = 1 To UBound(arrSht1(), 1) Step 1 ' Counting at each row of NEW Dim MtchRes As Variant Let MtchRes = Application.Match(arrSht1Chk(Cnt), arrSht2Chk(), 0) ' If IsError(MtchRes) Then ' case data is MISSING: NEW ( MISSING: ) ' This straight forward modification to the existing code will not work. This is because the code modifies the check array , arrSht2Chk() , when checking for the data from Original in NEW ' Let arrOut(Cnt, 1) = "Missing: " & arrSht1(Cnt, 1): arrOut(Cnt, 2) = "MISSING:: " & arrSht1(Cnt, 2) ' Else: '3a(ii) action whilst match is found --Inner Loop------ Do While Not IsError(MtchRes) ' The 3a Loop Dim DupyCnt As Long: Let DupyCnt = DupyCnt + 1 If DupyCnt > 1 Then Let arrOut(MtchRes, 1) = "Dup " & DupyCnt & " of " & arrOut(MtchRes, 1): arrOut(MtchRes, 2) = "Dup " & DupyCnt & " of " & arrOut(MtchRes, 2) Else Let arrOut(MtchRes, 1) = "": arrOut(MtchRes, 2) = "": arrOut(MtchRes, 3) = "": arrOut(MtchRes, 4) = "": arrOut(MtchRes, 5) = "" ' remove the found data from array for output so that next line can look again for a possible duplicate End If Let arrSht2Chk(MtchRes) = "" ' remove entry in check array so that next line can look for possible duplicate Let MtchRes = Application.Match(arrSht1Chk(Cnt), arrSht2Chk(), 0) Loop ' ---------------------------------------- ' End If ' Let DupyCnt = 0 ' reset the Duplicated data count for next row of data in Original Next Cnt ' ========= End Main loop ================= effectively we go to next row of data in Original with this line Rem 3b Second Loop ' ##### Start Second loop ##### For Cnt = 1 To UBound(arrSht1(), 1) Step 1 ' Counting at each row of NEW 'Dim MtchRes As Variant Let MtchRes = Application.Match(arrSht1Chk(Cnt), arrSht2ChkKopie, 0) If IsError(MtchRes) Then ' case data is missing NEW ( MISSING: ) Let arrOut(Cnt, 1) = "MISSING: " & arrSht1(Cnt, 1): arrOut(Cnt, 2) = "MISSING: " & arrSht1(Cnt, 2): arrOut(Cnt, 3) = "MISSING: " & arrSht1(Cnt, 4): arrOut(Cnt, 4) = "MISSING: " & arrSht1(Cnt, 5): arrOut(Cnt, 5) = "MISSING: " & arrSht1(Cnt, 6) Else End If ' Let DupyCnt = 0 ' reset the Duplicated data count for next row of data in Original Next Cnt ' ##### End Second Loop ################# effectively we go to next row of data in Original with this line Rem 3c(i) Third Loop ' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ For Cnt = 1 To UBound(arrOut(), 1) Step 1 ' Counting at each row of output arrray If InStr(1, arrOut(Cnt, 1), "MISSING:", vbBinaryCompare) <> 1 Then Dim Cntx As Long ' for loop across "columns" '3c(ii) Loop across columns in output array For Cntx = 1 To 2 ' .....we need to break up into two loops, as we have columns in Output array of 1 2 3 4 5 but in Input array for sheet 1 we have B C D E F G .. D is ignored, If arrOut(Cnt, Cntx) <> "" And arrOut(Cnt, Cntx) <> CStr(arrSht1(Cnt, Cntx)) Then ' condition for changed data Let arrOut(Cnt, Cntx) = CStr(arrSht1(Cnt, Cntx)) & " < > " & arrOut(Cnt, Cntx) Else End If Next Cntx For Cntx = 3 To UBound(arrOut(), 2) ' we need to do break up into two loops...... If arrOut(Cnt, Cntx) <> "" And arrOut(Cnt, Cntx) <> CStr(arrSht1(Cnt, Cntx + 1)) Then ' condition for changed data Let arrOut(Cnt, Cntx) = CStr(arrSht1(Cnt, Cntx + 1)) & " < > " & arrOut(Cnt, Cntx) Else End If Next Cntx Else ' case we have a Missing row, so no action in Third Loop 3c End If Next Cnt ' @@@@@ End Third Loop ' @@@@@@@@@@@@@@@@@ Rem 5 Output in new file For testing purposes, I give the output in a third worksheet, Tabelle3 Dim Ws3 As Worksheet: Set Ws3 = ThisWorkbook.Worksheets("Result") Ws3.Cells.ClearContents Let Ws3.Range("A1:F1").Value = "Original": Ws3.Range("G1:K1").Value = "Test Output": Ws3.Range("L1:Q1").Value = "NEW" Let Ws3.Range("A2").Resize(UBound(arrSht1(), 1), UBound(arrSht1(), 2)).Value = arrSht1() Let Ws3.Range("G2").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2)).Value = arrOut() Let Ws3.Range("L2").Resize(UBound(arrSht2(), 1), UBound(arrSht2(), 2)).Value = arrSht2() Ws3.Columns.AutoFit Rem 6 MsgBox output ' MsgBox Prompt:="Inserted lines is " & AdedRows & vbCrLf & "Changed cells is " & DifCnt End Sub

Sample test results for code from last post ( http://www.excelfox.com/forum/showth...0758#post10758 )

Using Excel 2007 32 bit

Original Original Original Original Original Original Test Output Test Output Test Output Test Output Test Output NEW NEW NEW NEW NEW NEW

Assembly #: Assembly Name: Assembly #: Assembly Name:

Qty Per Ref/Designator Description Customer PN Internal PN Manufacture PN Qty Per Ref/Designator Description Customer PN Internal PN Manufacture PN

1
Nu Torque
13456

456

456

1
Nu Torque
13456

456

456

1
Blu Origin Spaceship
457

457

1
Blu Origin Spaceship
457

457

2
Jet Blue21 ABC
458

458
2 Jet Blue21 < > Jet Blue23 ABC 458 < > DEF 458 < > DEF
2
Jet Blue23 ABC DEF DEF

3
EXCELL123
123
ABC ABC
3
EXCELL123
123
ABC ABC

3
Toyota Supra
460

460

3
Toyota Supra
460

460

2
Emirate ABC12345
461

461

2
Emirate ABC12345
461

461

1
Angel ABC12346
462

462
MISSING: 1 MISSING: Angel MISSING: ABC12346 MISSING: 462 MISSING: 462
2
Jet Blue21 ABC
458

458

Worksheet: Result

Using Excel 2007 32 bit

Test Output Test Output Test Output Test Output Test Output

2 Jet Blue21 < > Jet Blue23 ABC 458 < > DEF 458 < > DEF

MISSING: 1 MISSING: Angel MISSING: ABC12346 MISSING: 462 MISSING: 462

Worksheet: Result