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

**DocAElstein** · 07-26-2018, 02:33 PM

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

**DocAElstein** · 07-26-2018, 02:43 PM

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

**DocAElstein** · 07-29-2018, 11:51 AM

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

**DocAElstein** · 07-29-2018, 12:00 PM

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 )

**DocAElstein** · 07-29-2018, 01:31 PM

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

**DocAElstein** · 07-29-2018, 01:33 PM

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

Using Excel 2007 32 bit

Original

Test Output

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

1

Nu Torque

13456

456

1

Blu Origin

Spaceship

457

1

Blu Origin

Spaceship

457

2

Jet Blue21

ABC

458

2

Jet Blue21 < > Jet Blue23

ABC

458 < > DEF

2

Jet Blue23

ABC

DEF

3

EXCELL123

123

ABC

3

EXCELL123

123

ABC

3

Toyota

Supra

460

3

Toyota

Supra

460

2

Emirate

ABC12345

461

2

Emirate

ABC12345

461

1

Angel

ABC12346

462

MISSING: 1

MISSING: Angel

MISSING: ABC12346

MISSING: 462

2

Jet Blue21

ABC

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

**DocAElstein** · 07-30-2018, 12:38 PM

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

**DocAElstein** · 07-30-2018, 12:43 PM

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

Test Output

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

1

Nu Torque

13456

456

1

Blu Origin

Spaceship

457

1

Blu Origin

Spaceship

457

2

Jet Blue21

ABC

458

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

2

Jet Blue23

ABC

DEF

3

EXCELL123

123

ABC

3

EXCELL123

123

ABC

3

Toyota

Supra

460

3

Toyota

Supra

460

2

Emirate

ABC12345

461

2

Emirate

ABC12345

461

1

Angel

ABC12346

462

MISSING: 1 Angel ABC12346 462 462

2

Jet Blue21

ABC

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

**DocAElstein** · 07-31-2018, 12:54 PM

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
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
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

**DocAElstein** · 08-02-2018, 11:57 AM

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