How to scan streaming data in multiple paired CSV files

[Ed Harris]

Hello,

I am trying to scan some streaming data and compare the results for anomalies.

The data in the pairs of files corresponds by file number and the two file sets are in separate folders.

I currently copy the data from the two CSV files and paste into Excel with the text import wizard. Then run two VBA macros to highlight any anomalies in columns 2 to 4 and 13 to 15 with yellow cell fill. I then use find in excel to locate cells with the yellow fill.

This is not sustainable as I am producing a pair of files every 2 hours 24/7.

An additional prolem is that some of the files have no anomalies in them so are currently of no interest and creating an excel file to look at them is going to be a waste of data storage space.

Any highlighed cells are potentially interesting but the result I am most interested in is if there are anomalies in any two columns that are in the same row. But near rows also, in case the synchronisation of the files becomes slightly off.



Any suggestions how to streamline this process would be very much appreciated. A first step might be to fix the VBA code so that it doesnt highlight the longer rows and fail at the last row



Code to highlight anomalies in the data that are 0.004 greater or less than the cells either side.

Sub TestyellowColumn1314() ' searches for cells that are higher or lower than their column neighbours and
'colours them yellow (works ok except for last row)Change "j" for relevant columns

   Dim i As Long, j As Long
   Dim lastRow As Long
   Dim InArr As Variant
   Dim DeltaLeft As Double
   Dim DeltaRight As Double
   
   Const Tolerance = 0.004
   
   lastRow = Cells(Rows.Count, "A").End(xlUp).Row
   InArr = Range(Cells(1, 1), Cells(lastRow, 80))
   
   
   For i = 4 To lastRow
      For j = 2 To 4
      'For j = 13 To 15
         DeltaLeft = Abs(InArr(i, j) - InArr(i - 1, j))
         
         If Not IsEmpty(InArr(i - 1, j)) Then
            DeltaRight = Abs(InArr(i, j) - InArr(i + 1, j))
         Else
            DeltaRight = 0
         End If
         
         If DeltaRight >= Tolerance And DeltaLeft >= Tolerance Then
         With Range(Cells(i, j), Cells(i, j)).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = RGB(255, 255, 0) 'yellow
            .TintAndShade = 0
            .PatternTintAndShade = 0
         End With
         
         End If
      Next j
   Next i

End Sub

This is an example of the data but each block between may be 6000 rows.

0	1	1	0	0	1	6.1
0.521421	71.09699	72.60757	73.46169	112.5564								69.55162	69.55177	69.55188	112.4397
0.51895	71.09705	72.60716	73.46151	112.6565								69.55185	69.55166	69.55194	112.5405
0.51895	71.09697	72.60658	73.46164	112.7564								69.55196	69.55166	69.55171	112.6407
0.511536	71.09677	72.60672	73.46151	112.856								69.55182	69.55187	69.55154	112.7422
0.516479	71.09665	72.60689	73.46166	112.9562								69.55155	69.55201	69.55164	112.8422
45715.95	45715.95	45715.95	45715.95	0.00008	45715.95	45715.95	45715.95	45715.95	0	601.2442		45715.95	45715.95	601.1686
0.51895	71.09666	72.60669	73.46155	113.0578								69.55156	69.55175	69.55193	112.9431
0.514008	71.09664	72.60642	73.46169	113.1575								69.5518	69.55158	69.55158	113.0424
0.521421	71.09701	72.60632	73.46166	113.2586								69.55749	69.55065	69.55287	113.1432
0.523892	71.09698	72.60649	73.46162	113.3598								69.55304	69.55296	69.55114	113.2435
0.516479	71.09699	72.60664	73.46152	113.4592								69.55138	69.55279	69.55188	113.3435
45715.95	45715.95	45715.95	45715.95	0.00011	45715.96	45715.96	45715.96	45715.96	0	601.2648		45715.95	45715.96	602.2369

 

[Sam_D_Ben]

Please try,

Sub testAnomalies()
    Dim wsSource As Worksheet
    Dim wsSummary As Worksheet
    Dim i As Long, j As Long
    Dim lastRow As Long
    Dim InArr As Variant
    Dim DeltaLeft As Double, DeltaRight As Double
    Const Tolerance As Double = 0.004
    Dim anomalyCount As Integer
    Dim summaryRow As Long
    Dim flatRow As Boolean

    Set wsSource = ActiveSheet
    lastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    InArr = wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(lastRow, 80)).Value

    On Error Resume Next
    Set wsSummary = Sheets("Anomalies")
    If wsSummary Is Nothing Then
        Set wsSummary = Sheets.Add
        wsSummary.Name = "Anomalies"
    Else
        wsSummary.Cells.Clear
    End If
    On Error GoTo 0

    summaryRow = 1

    For i = 2 To lastRow - 1
        anomalyCount = 0
        flatRow = True

        For j = 2 To 4
            If InArr(i, j) <> InArr(i, j + 1) Then flatRow = False
        Next j
        For j = 13 To 14
            If InArr(i, j) <> InArr(i, j + 1) Then flatRow = False
        Next j
        If flatRow Then GoTo SkipRow

        For j = 2 To 4
            If IsNumeric(InArr(i, j)) And IsNumeric(InArr(i - 1, j)) And IsNumeric(InArr(i + 1, j)) Then
                DeltaLeft = Abs(InArr(i, j) - InArr(i - 1, j))
                DeltaRight = Abs(InArr(i, j) - InArr(i + 1, j))
                If DeltaLeft >= Tolerance And DeltaRight >= Tolerance Then
                    anomalyCount = anomalyCount + 1
                    wsSource.Cells(i, j).Interior.Color = RGB(255, 255, 0)
                End If
            End If
        Next j

        For j = 13 To 15
            If IsNumeric(InArr(i, j)) And IsNumeric(InArr(i - 1, j)) And IsNumeric(InArr(i + 1, j)) Then
                DeltaLeft = Abs(InArr(i, j) - InArr(i - 1, j))
                DeltaRight = Abs(InArr(i, j) - InArr(i + 1, j))
                If DeltaLeft >= Tolerance And DeltaRight >= Tolerance Then
                    anomalyCount = anomalyCount + 1
                    wsSource.Cells(i, j).Interior.Color = RGB(255, 255, 0)
                End If
            End If
        Next j

        If anomalyCount >= 2 Then
            wsSource.Rows(i).Copy Destination:=wsSummary.Rows(summaryRow)
            summaryRow = summaryRow + 1
        End If

SkipRow:
    Next i
   
End Sub

 

[Ed Harris]

@ Sam_D_Ben,
That looks impressive, I am not quite sure how to use it. Do I have to import the csv files to a spreadsheet beforehand? I failed to mention clearly that the data example is shown how it appears already put in a worksheet from the two CSV source files. The 11 leftmost columns from one file and the four rightmost columns being from the other file.

 

[Sam_D_Ben]

Please share a copy of your csv file here.

 

[Ed Harris]

Here are examples of the CSV files
File A
File B

 

[Sam_D_Ben]

Here are examples of the CSV files
File A
File B

Did you find any anomalies in this?

 

[Ed Harris]

Yes, starting at rows 31194 and 33951.
I am wondering if I should be looking to create a list of file names and row numbers so that I can then create excel files of just the interesing csv files?

 

[Fuji]

According to the files uploaded.
When dialog appears, select File A then File B, otherwise the code will not work since the files have different formats.

Sub test()
    Dim fn$(1), a, i&, ii&, iii&, n&, x, y(2), s$, t&, flg As Boolean, ws As Worksheet
    For i = 0 To 1
        fn(i) = Application.GetOpenFilename("TextFiles,*.txt")
        If fn(i) = "False" Then Exit Sub
    Next
    Set ws = Sheets("sheet1")   '<--- output sheet
    ws.Cells.Delete
    ReDim a(1 To Rows.Count, 1 To 1)
    For i = 0 To 1
        s = Space(FileLen(fn(i)))
        Open fn(i) For Binary As #1
            Get #1, , s
        Close #1
        x = Split(s, vbCrLf): ReDim a(1 To UBound(x) * 3, 1 To 1)
        t = IIf(i = 0, 0, 1): s = "": a(1, 1) = fn(i): n = 1
        For ii = 2 To UBound(x) - 1
            y(0) = Split(x(ii - 1), ",")
            y(1) = Split(x(ii), ",")
            y(2) = Split(x(ii + 1), ",")
            If UBound(y(2)) < 3 Then Exit For
            flg = False
            For iii = 0 To 2
                If Trim$(y(iii)(0)) Like "*:*" Then flg = True: Exit For
            Next
            If Not flg Then
                For iii = 1 To 3
                    If (Abs(Val(y(1)(iii - t)) - Val(y(0)(iii - t))) >= 0.004) * _
                        (Abs(Val(y(2)(iii - t)) - Val(y(1)(iii - t))) >= 0.004) Then
                        n = n + 4
                        a(n - 2, 1) = "Row " & ii & "," & x(ii - 1)
                        a(n - 1, 1) = "Row " & ii + 1 & "," & x(ii)
                        a(n, 1) = "Row " & ii + 2 & "," & x(ii + 1)
                        ii = ii + 2: Exit For
                    End If
                Next
            End If
        Next
        ii = ws.Evaluate(Replace("max(if(#<>"""",column(#)))", "#", ws.UsedRange.Address))
        With ws.Cells(1, ii + t + 1).Resize(n)
            .Value = a: .Cells(1) = fn(i)
            .TextToColumns .Cells(1), 1, comma:=True
            If n > 1 Then
                With .Offset(1, 2 - t).Resize(, 3)
                    .FormatConditions.Delete
                    .FormatConditions.Add 2, Formula1:= _
                    "=and(count(" & .Cells(0, 1).Resize(3).Address(0, 0) & ")=3," & _
                    "abs(" & .Cells(1).Address(0, 0) & "-" & .Cells(0, 1).Address(0, 0) & ")>=0.004" & _
                    ",abs(" & .Cells(2, 1).Address(0, 0) & "-" & .Cells(1).Address(0, 0) & ")>=0.004)"
                    .FormatConditions(.FormatConditions.Count).Interior.Color = vbYellow
                End With
            End If
        End With
    Next
End Sub

 

[Ed Harris]

@Fuji, Thats a great help. It will save me hours. I am often stunned by the generosity of people on this forum.
Ed

 

[Fuji]

You are welcome and glad if you like it.