Test Video,YouTube, Video making and editing, etc. coupled to excelfox (OBS)

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

1 Attachment(s)

Code for alternative(2) output
In support of this post:
http://www.excelfox.com/forum/showth...0764#post10764

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")) Call Out2Testies(Worksheets("Original"), Worksheets("NEW")) End Sub Sub Out2Testies(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 arrOut(1 To UBound(arrSht2(), 1), 1 To 1) ' arrOut() is now only one column, as I am using the concatenated string in the output 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) = arrSht2Chk(Cnt) 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 " & arrSht2ChkKopie(MtchRes) Else Let arrOut(MtchRes, 1) = "" 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: " & arrSht1Chk(Cnt) 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 If arrOut(Cnt, 1) <> "" Then ' Let arrOut(Cnt, 1) = arrSht1Chk(Cnt) & " < > " & arrOut(Cnt, 1) Else End If 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").Value = "Test Output": Ws3.Range("H1:M1").Value = "NEW" Let Ws3.Range("A2").Resize(UBound(arrSht1(), 1), UBound(arrSht1(), 2)).Value = arrSht1() Let Ws3.Range("G2").Resize(UBound(arrOut(), 1), 1).Value = arrOut() Let Ws3.Range("H2").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

test results from code above, ( http://www.excelfox.com/forum/showth...0762#post10762 ) in support of this post:
http://www.excelfox.com/forum/showth...0764#post10764

Using Excel 2007 32 bit

_Row\^Col
A

B

C

D

E

F

G

H

I

J

K

L

M

1
Original Original Original Original Original Original 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 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 Angel ABC12346 462 462
2
Jet Blue21 ABC
458

458

Worksheet: Result

Using Excel 2007 32 bit

Original Original Original Original Original Original 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 ABC 458 458 < > 2 Jet Blue23 ABC DEF 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 Angel ABC12346 462 462
2
Jet Blue21 ABC
458

458

Worksheet: Result

Using Excel 2007 32 bit

_Row\^Col
G

1
Test Output

2

3

4

5

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

7

8

9

10
MISSING: 1 Angel ABC12346 462 462

Worksheet: Result

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Original	Original	Original	Original	Original	Original	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 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 Angel ABC12346 462 462	2	Jet Blue21		ABC	458	458

_Row\^Col	G
1	Test Output
2
3
4
5
6	2 Jet Blue21 ABC 458 458 < > 2 Jet Blue23 ABC DEF DEF
7
8
9
10	MISSING: 1 Angel ABC12346 462 462

Test data in support of this Post:
http://www.excelfox.com/forum/showth...0766#post10766

Using Excel 2007 32 bit

_Row\^Col
A

B

C

D

E

F

1
1 L 1 1 L 1,1 L 1

2
1 G 1 1 E 1 1 L 1,1 L 1 1 E 1

3
1 G 1 1 E 1 1 L 1,1 L 1 1 E 1 1 G 1

4
1 E 1 1 G 1

5

Worksheet: Sheet2

Using Excel 2007 32 bit

_Row\^Col
A

B

C

D

E

F

G

H

I

J

1
1 L 1 1 E 1 1 L 1,1 L 1 1 G 1

2
1 G 1 1 E 1 1 L 1 1 L 1 1 G 1

3
1 L 1 1 L 1,1 L 1 1 L 1 1 G 1

4
1 L 1 1 L 1,1 L 1

5
1 L 1 1 G 1 1 E 1 1 L 1

6
1 G 1 1 L 1 1 L 1,1 L 1 1 L 1 1 L 1 1 G 1

7
1 E 1 1 E 1 1 L 1,1 L 1 1 L 1 1 G 1

8
1 E 1 1 G 1 1 E 1 1 L 1,1 L 1 1 G 1 1 G 1 1 G 1 1 G 1

9
1 E 1 1 E 1 1 L 1 1 L 1 1 G 1 1 G 1 1 G 1 1 G 1 1 G 1

10

Worksheet: Sheet3

_._______________________

The results after running the code given on Post #3 of main Thread ( http://www.excelfox.com/forum/showth...0766#post10766 )
Using Excel 2007 32 bit

_Row\^Col
A

B

C

D

1
20abc

2
abc20

3
def

4
ghi

5

Worksheet: Sheet4

_Row\^Col	A	B	C	D	E
1	1 L 1	1 L 1,1 L 1
2	1 G 1	1 E 1	1 L 1,1 L 1	1 E 1
3	1 G 1	1 E 1	1 L 1,1 L 1	1 E 1	1 G 1
4	1 E 1	1 G 1
5

_Row\^Col	A	B	C	D	E	F	G	H	I
1	1 L 1	1 E 1	1 L 1,1 L 1	1 G 1
2	1 G 1	1 E 1	1 L 1	1 L 1	1 G 1
3	1 L 1	1 L 1,1 L 1	1 L 1	1 G 1
4	1 L 1	1 L 1,1 L 1
5	1 L 1	1 G 1	1 E 1	1 L 1
6	1 G 1	1 L 1	1 L 1,1 L 1	1 L 1	1 L 1	1 G 1
7	1 E 1	1 E 1	1 L 1,1 L 1	1 L 1	1 G 1
8	1 E 1	1 G 1	1 E 1	1 L 1,1 L 1	1 G 1	1 G 1	1 G 1	1 G 1
9	1 E 1	1 E 1	1 L 1	1 L 1	1 G 1	1 G 1	1 G 1	1 G 1	1 G 1
10

1 Attachment(s)

Attaching a File to a Thread post at excelfox

Attaching a File to a Thread post at excelfox
1 To get Manage Attachments Window dialogue box
First you must get up the Manage Attachments Window dialogue box.

_(i) For a new Thread
Either
_1_(i) _a) Select Paper clip icon
Or
_1_(i) _b) Scroll down and select manage attachments
a)PaperClipIcon or b)ManageAttachmants.JPG : https://imgur.com/YFEUDUh

(ii) For a Reply or when Editing an existing post
_ Hit Reply button or Edit Post Button
Reply or Edit Post.JPG : https://imgur.com/Bm1Zy6T
_ Hit Go Advanced button
GoAdvancedReplyWindow.JPG , GoAdvanced1.JPG : https://imgur.com/QLhHBGl , https://imgur.com/WXoKcoF
_ Scroll down and select manage attachments
Scroll down to Hit manage Attachments.JPG : https://imgur.com/uNkr6Eq

Finally you should see the Manage Attachments Window dialogue box
Manage Attachments Window dialogue box.JPG : https://imgur.com/BFFUIuG
Attachment 2103

Using this dialogue box window you can manage your attachments
2 To add a File to the current post:
Steps like the following are needed to attach a file to the current post. It may look a little bit different on your computer
_ Add Files.JPG : https://imgur.com/hIdo0Av
_ SelectFiles.JPG : https://imgur.com/9XZJuig
_ UploadFiles5.JPG : https://imgur.com/f0PXtVA
_ Done6.JPG : https://imgur.com/a6oFeIQ
That's it!...:)
The file should now have been attached.

_._______

Practice before posting in a main Thread:
You can practice uploading a file by starting a new test thread here:
http://www.excelfox.com/forum/forumd...p/17-Test-Area
Give the Thread a title such as …"Just testing. No Reply needed"
Test Area new Thread 1 .JPG , Test Area new Thread just testing .JPG https://imgur.com/S3uneWf , https://imgur.com/gUFHcBp

You can then practice uploading attachments or you can also practice any other posting and editing features, such as code tags ( http://www.excelfox.com/forum/showth...0690#post10690 )

_._____________________________

Alternative to attaching a file: post a link to your file held at a file share site:
See here for example:
http://www.excelfox.com/forum/showth...age8#post10725
Or if you are familiar with file sharing sites go direct here
https://account.box.com/signup/n/personal#58luf