I need to import 2 .s19 files to Excel and then compare across 6 Columns and store the output to a txt file. I have my data from column A to F. My current program doesn't store the data using a dictionary or hashtable. It takes too long to complete as there are around 31k lines in the list 1 and 32k lines in list 2. I would like to use a dictionary to store the data but I am unsure how to do it.
My data is in this format:
Source Data Dump Data
A B C D E F
[1] file format(4char) address(6char) data(66char) file format(4char) address(6char) data(66char)
1) If the first line (A2) or (D2) starts with "S011" or "S804" skip and read next line.
2) If the address in Column B matches the address in Column E, check if the adjacent data linked to it is also a match ie. if B10 = E10, check if C10 = F10. If there is a mismatch in data output to txt file in this format:
Source Data
Address
A10+B10+C10
Dump Data
Address
D10+E10+F10
Result: NOK
3) If column B address is not found in Column E ,
Output :
Source Data
Address
A10+B10+C10
Result: NOK
4) If column E address is not found in Column B , check if the string of data in column F are all 'F's excluding the last 2 characters. if All F's then output OK if Not All F's then output NOK
Output :
Dump Data
Address
D10+E10+F10
Result: NOK
My current code:
Sub Compare()
Worksheets(1).Select
Dim orig_folderpath As String, orig_file As String, orig_filename As String
Dim dump_folderpath As String
Dim OutputPath As String, OutputFilename As String
Dim VarEntry As String
Dim count As Integer
Dim mainWB As Workbook
Dim Result As String
Dim startadd As String, endadd As String, Dec_startadd As String, lgth As Integer
Set mainWB = ActiveWorkbook
dump_folderpath = Range("C2").Value
Application.DisplayAlerts = False
For i = mainWB.Sheets.count To 3 Step -1
Sheets(i).Delete
Next
Application.DisplayAlerts = True
count = 0
Dim dump_file As String, dump_filename As String
dump_file = dump_folderpath & "\dump_*.s19"
dump_filename = Dir(dump_file)
OutputPath = Range("C4").Value
OutputFilename = Range("E4").Value
VarEntry = Range("C3").Value
Do While dump_filename <> ""
count = count + 1
'dump_file_(count) = dump_filename
dump_filename = Dir()
mainWB.Sheets.Add(After:=mainWB.Sheets(mainWB.Sheets.count)).Name = "Dump" & count & "_Comparision"
'Worksheets(count + 1).Select
'ActiveSheet.Name = "Dump" & count & "_Comparision"
Loop
dump_filename = Dir(dump_file)
ReDim dump_file_(count) As String
For j = 1 To count
dump_file_(j) = dump_filename
dump_filename = Dir()
Next
Worksheets(1).Select
orig_folderpath = Range("C1").Value
orig_filename = Range("E1").Value
orig_file = orig_folderpath & "\" & orig_filename & ".s19"
'ActiveWorkbook.Worksheets.Add
For k = 1 To count
Worksheets(k + 2).Select
Range("A1") = "Original File"
Range("A2") = "Record type,Byte count"
Range("B2") = "Address"
Range("C2") = "Data,Checksum"
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & orig_file, Destination:=Range("$A$3"))
.Name = orig_filename
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("A3"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(4, 2), Array(10, 2)), TrailingMinusNumbers:= _
True
ActiveSheet.Columns().AutoFit
Worksheets(k + 2).Select
Range("D1") = "Dump File" & k
Range("D2") = "Record type,Byte count"
Range("E2") = "Address"
Range("F2") = "Data,Checksum"
Range("F1") = dump_file_(k)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & dump_folderpath & "\" & dump_file_(k), Destination:=Range("$D$3"))
.Name = dump_file_(k)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("D3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("D3"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(4, 2), Array(10, 2)), TrailingMinusNumbers:= _
True
ActiveSheet.Columns().AutoFit
Next
y = 2
For x = 1 To count
Worksheets(y + x).Select
'Get a the next available file number
fn = FreeFile
'Open your file ready for writing.
'Set fs = CreateObject("Scripting.FileSystemObject")
'Set a = fs.CreateTextFile(output_file, True)
output_file = OutputPath & "\" & OutputFilename & x & ".txt"
Open output_file For Output As #fn
'Set the First row to search from.
If (Range("A3") = "S011" Or Range("A3") = "S804") Then
fr = 4
Else
fr = 3
End If
'Find the last row.
'lr = ActiveCell.SpecialCells(xlLastCell).Row
lr = Range("A1").End(xlDown).Row
lr_2 = Range("D1").End(xlDown).Row
'lr = 20
'lr_2 = 20
'Set the column for the value that you are searching for.
sf = "B"
Debug.Print "sf" & sf
'Set the column for that you are searching in.
si = "E"
Debug.Print "si" & si
'You want to search two columns
'first = 0
For l = 1 To 2
Debug.Print "l" & l
'Loop from first row to the last row.
For cr = fr To lr
Debug.Print "cr" & cr
'Set the address you're trying to find
fa = Range(sf & cr).Value
fa_data = Range(Chr(Asc(sf) + 1) & cr).Value
Debug.Print "fa" & fa
'Find it
Set targetcell = Range(si & 3 & ":" & si & lr_2).Find(What:=fa, LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
'If Nothing is returned it is not found
If targetcell Is Nothing Then
'Write your search cell and it's ajacent to your file.
If l = 1 Then
startadd = Range(sf & cr).Value
If startadd <> "FFFFFF" Then
Dec_startadd = Val("&H" & startadd & "&H")
lgth = Len(Range(Chr(Asc(sf) + 1) & cr)) - 2
lgth = lgth / 2 - 1
endadd = Hex(Dec_startadd + lgth)
endadd = Right("000000" & endadd, 6)
Print #fn, "File:" & orig_filename
Print #fn, "0x" & startadd & " - 0x" & endadd
Print #fn, Range(Chr(Asc(sf) - 1) & cr).Value & Range(sf & cr).Value & Range(Chr(Asc(sf) + 1) & cr).Value
Print #fn, "Result: NOK"
Print #fn,
Print #fn,
'Else
'Print #fn, "File:" & orig_filename
'Print #fn, "0x" & startadd
'Print #fn, Range(Chr(Asc(sf) - 1) & cr).Value & Range(sf & cr).Value & Range(Chr(Asc(sf) + 1) & cr).Value
'Print #fn, "Result: NOK"
End If
ElseIf l = 2 Then
startadd = Range(sf & cr).Value
Dec_startadd = Val("&H" & startadd & "&H")
lgth = Len(Range(Chr(Asc(sf) + 1) & cr)) - 2
lgth = lgth / 2 - 1
endadd = Hex(Dec_startadd + lgth)
endadd = Right("000000" & endadd, 6)
Result = "File:" & dump_file_(x)
Value = Range(Chr(Asc(sf) + 1) & cr).Value
myString = Left(Value, Len(Value) - 2)
Length = Len(myString)
'Val_Res = Application.WorksheetFunction.CountIf(myString, "F")
If CheckAllF(myString) = False Then
If (fa <> "00BFF0") Or (fa <> "00C010") Or (fa <> "00C030") Or (fa <> "00C050") Or (fa <> "00C070") _
Or (fa <> "00C090") Then
Print #fn, "File:" & dump_file_(x)
Print #fn, "0x" & startadd & " - 0x" & endadd
Print #fn, Range(Chr(Asc(sf) - 1) & cr) & Range(sf & cr) & Range(Chr(Asc(sf) + 1) & cr)
Print #fn, "Result: NOK"
Print #fn,
Print #fn,
End If
Else
If (fa <> "00BFF0") Or (fa <> "00C010") Or (fa <> "00C030") Or (fa <> "00C050") Or (fa <> "00C070") _
Or (fa <> "00C090") Then
Print #fn, "File:" & dump_file_(x)
Print #fn, "0x" & startadd & " - 0x" & endadd
Print #fn, "Result: OK"
Print #fn,
Print #fn,
End If
End If
End If
'If address is found
Else
'If Data matches
If Cells(targetcell.Row, (targetcell.Column) + 1).Value = Cells(cr, Chr(Asc(sf) + 1)).Value Then
'If Data mismatch
Else
If l = 1 Then
Print #fn, "File:" & orig_filename
Print #fn, Range(Chr(Asc(sf) - 1) & cr).Value & Range(sf & cr).Value & _
Range(Chr(Asc(sf) + 1) & cr).Value
Print #fn, "File:" & dump_file_(x)
Print #fn, Range(Chr(Asc(si) - 1) & targetcell.Row) & Range(si & targetcell.Row) & _
Range(Chr(Asc(si) + 1) & targetcell.Row)
Print #fn, "Result: NOK"
Print #fn,
Print #fn,
End If
End If
End If
'I always put a DoEvents in a loop; just in case you need to break out of it.
DoEvents
Next
'Now you've done one column swap them over and do it again.
sf = "E"
si = "B"
Debug.Print "sf" & sf
Debug.Print "si" & si
If (Range("D3") = "S011" Or Range("D3") = "S804") Then
fr = 4
Else
fr = 3
End If
lr_3 = lr
lr = lr_2
lr_2 = lr_3
Next
'Manufacturing Data Check
'Addresses: 00BFF0, 00C010, 00C030, 00C050, 00C070, 00C090
Dim data1 As String, data2 As String, data3 As String, data4 As String, data5 As String, data6 As String, data7 As String, _
data8 As String, data9 As String, data10 As String, data11 As String
Set targetcell = Range(E & 3 & ":" & E & lr).Find(What:="00BFF0", LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
'test setting
'Set targetcell = Range(E & 3 & ":" & E & lr).Find(What:="000000", LookIn:=xlValues, _
'SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
d1 = Cells(targetcell.Row, (targetcell.Column) + 1).Value
d2 = Cells((targetcell.Row) + 1, (targetcell.Column) + 1).Value
d3 = Cells((targetcell.Row) + 2, (targetcell.Column) + 1).Value
d4 = Cells((targetcell.Row) + 3, (targetcell.Column) + 1).Value
d5 = Cells((targetcell.Row) + 4, (targetcell.Column) + 1).Value
d6 = Cells((targetcell.Row) + 5, (targetcell.Column) + 1).Value
data1 = Mid(d1, 33, 32)
data2 = Mid(d2, 1, 32)
data3 = Mid(d2, 33, 32)
data4 = Mid(d3, 1, 32)
data5 = Mid(d3, 33, 32)
data6 = Mid(d4, 1, 32)
data7 = Mid(d4, 33, 32)
data8 = Mid(d5, 1, 32)
data9 = Mid(d5, 33, 32)
data10 = Mid(d6, 1, 32)
data11 = Mid(d6, 33, 32)
Workbooks.Open Filename:=orig_folderpath & "\manufacturing input file.xls"
Dim line1 As String, line2 As String, line3 As String, line4 As String, line5 As String, line6 As String, line7 As String, _
line8 As String, line9 As String, line10 As String, line As String
Set tcell = Range("A:A").Find(What:=VarEntry, LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
For l = 1 To 16
line1 = line1 & Right(Cells(tcell.Row + 2, tcell.Column + l), 2)
Next
For l = 1 To 16
line2 = line2 & Right(Cells(tcell.Row + 3, tcell.Column + l), 2)
Next
For l = 1 To 16
line3 = line3 & Right(Cells(tcell.Row + 4, tcell.Column + l), 2)
Next
For l = 1 To 16
line4 = line4 & Right(Cells(tcell.Row + 5, tcell.Column + l), 2)
Next
For l = 1 To 16
line5 = line5 & Right(Cells(tcell.Row + 6, tcell.Column + l), 2)
Next
For l = 1 To 16
line6 = line6 & Right(Cells(tcell.Row + 7, tcell.Column + l), 2)
Next
For l = 1 To 16
line7 = line7 & Right(Cells(tcell.Row + 8, tcell.Column + l), 2)
Next
For l = 1 To 16
line8 = line8 & Right(Cells(tcell.Row + 9, tcell.Column + l), 2)
Next
For l = 1 To 16
line9 = line9 & Right(Cells(tcell.Row + 10, tcell.Column + l), 2)
Next
For l = 1 To 16
line10 = line10 & Right(Cells(tcell.Row + 11, tcell.Column + l), 2)
Next
For l = 1 To 16
line11 = line11 & Right(Cells(tcell.Row + 12, tcell.Column + l), 2)
Next
line1 = Replace(line1, "X", "?")
line2 = Replace(line2, "X", "?")
line3 = Replace(line3, "X", "?")
line4 = Replace(line4, "X", "?")
line5 = Replace(line5, "X", "?")
line6 = Replace(line6, "X", "?")
line7 = Replace(line7, "X", "?")
line8 = Replace(line8, "X", "?")
line9 = Replace(line9, "X", "?")
line10 = Replace(line10, "X", "?")
line11 = Replace(line11, "X", "?")
ActiveWorkbook.Close SaveChanges:=False
'test setting
'data1 = "01000000000000000000002020202020"
'data2 = "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF"
Dim sMatch As Boolean, sMatch1 As Boolean, sMatch2 As Boolean, sMatch3 As Boolean, sMatch4 As Boolean, sMatch5 As Boolean, _
sMatch6 As Boolean, sMatch7 As Boolean, sMatch8 As Boolean, sMatch9 As Boolean, sMatch10 As Boolean, sMatch11 As Boolean
sMatch1 = data1 Like line1
sMatch2 = data2 Like line2
sMatch3 = data3 Like line3
sMatch4 = data4 Like line4
sMatch5 = data5 Like line5
sMatch6 = data6 Like line6
sMatch7 = data7 Like line7
sMatch8 = data8 Like line8
sMatch9 = data9 Like line9
sMatch10 = data10 Like line10
sMatch11 = data11 Like line11
Debug.Print data1 & " " & line1
Debug.Print data2 & " " & line2
Debug.Print data3 & " " & line3
Debug.Print data4 & " " & line4
Debug.Print data5 & " " & line5
Debug.Print data6 & " " & line6
Debug.Print data7 & " " & line7
Debug.Print data8 & " " & line8
Debug.Print data9 & " " & line9
Debug.Print data10 & " " & line10
Debug.Print data11 & " " & line11
Debug.Print "1" & sMatch1, "2" & sMatch2, "3" & sMatch3, "4" & sMatch4, "5" & sMatch5, "6" & sMatch6, "7" & sMatch7, _
"8" & sMatch8, "9" & sMatch9, "10" & sMatch10, "11" & sMatch11
sMatch = sMatch1 And sMatch2 And sMatch3 And sMatch4 And sMatch5 And sMatch6 And sMatch7 And sMatch8 And sMatch9 _
And sMatch10 And sMatch11
Debug.Print "sMatch: " & sMatch
Print #fn, "File:" & dump_file_(x)
Print #fn, "0x00BFF0 - 0x00C0AF"
For o = 1 To 6
Print #fn, Cells(targetcell.Row + o - 1, targetcell.Column - 1).Value & Cells(targetcell.Row + o - 1, _
targetcell.Column).Value & Cells(targetcell.Row + o - 1, targetcell.Column + 1).Value
Next
'Manufacturing Data Matches Table
If sMatch = True Then
Print #fn, "[MANUFACTURING DATA CHECK]: OK"
'Manufacturing Data Doesn't Match Table
Else
Print #fn, "[MANUFACTURING DATA CHECK]: NOK"
End If
Print #fn,
Print #fn,
line1 = ""
line2 = ""
line3 = ""
line4 = ""
line5 = ""
line6 = ""
line7 = ""
line8 = ""
line9 = ""
line10 = ""
line11 = ""
'It's done.
Close #fn
Next
End Sub
Function CheckAllF(ByVal myString As String) As Boolean
Dim isAllF As Boolean
isAllF = True
Dim index As Integer
For index = 1 To Len(myString)
If (Mid(myString, index, 1) <> "F") Then
isAllF = False
Exit For
End If
Next
CheckAllF = isAllF
End Function