Help with Macro To Organize Gas Chromatography Instrument Data

[NCase]

The code still only processes 64 out of 67 files when using a old dataset where the files are all named results.csv. The macro doesnt properly process the data when the results.csv are variable names. I am including examples of both types of datasets,

Best,

Franics

 

[Chihiro]

Hmm? It does import all 67 records for me from your sample.

However, I noticed you have some file with extra header. Which is throwing off things and wasn't included in your initial sample pattern.

Ex: 2018-11-28_1646 P09459 BLANK SYSTEM DECANE INJ.D


Highlighted portion will cause issue with import process. You'll need to specify how this section should be treated.

 

[NCase]

Hi,

Yes, damn instrument software. Those lines need to be ignored if and when those lines are present.

Can you send me a copy of your excel file with the macro. Maybe its something to do with my excel version. Its excel 2016.

Best,

Francis

 

[Chihiro]

I'm using same version and also I ran your file as is.

I'm bit busy right now. Will see if I have time later to workout logic to ignore those lines.

 

[Chihiro]

This should do it. Tested on both type1 and type2 from your sample and brought in all data.

Sub ImportData(iFile As String)
Dim dic As Object, ar
Dim y As Long, x As Long
Dim intFF As Integer: intFF = FreeFile()
Open iFile For Input As #intFF
y = 1
Set dic = CreateObject("Scripting.Dictionary")
Do Until EOF(1)
    Line Input #intFF, ReadData
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "(\[INT.+?: \d{4}-\d{2}-\d{2}_.+?data\.ms.*])$|(Header=,.+)|(\d.?\=\,\s.?\d.+$)"
        If .Test(ReadData) Then
            dic(ReadData) = 1
        End If
    End With
Loop

Close #intFF
sRow = IIf(Cells(Rows.Count, "A").End(xlUp).Row = 1, 1, Cells(Rows.Count, "A").End(xlUp).Row + 1)
x = Application.RoundUp(dic.Count / 2, 0)
For Each Key In dic.Keys
    If y <= x Then
        Range("A" & sRow + y - 1) = Key
    Else
        With CreateObject("VBScript.RegExp")
            .Pattern = Chr(34) & "[^\\" & Chr(34) & "]*(\\.[^\\" & Chr(34) & "]*)*" & Chr(34) & "|[^, ]+"
            .Global = True
            If .Execute(Key).Count < 10 Then
                Range("L" & sRow + y - x) = Key
            Else
                y = y - 1
            End If
        End With
    End If
    y = y + 1
Next
Set dic = Nothing
End Sub

Sub CheckAllSubFold()
Dim path As String: path = ThisWorkbook.path & "\"
Dim fName As String: fName = "*.CSV"
Dim cPath As String, coll As New Collection
cPath = Dir(path, vbDirectory)
Do While Len(cPath) > 0
    If Left(cPath, 1) <> "." And _
        (GetAttr(path & cPath) And vbDirectory) = vbDirectory Then
        coll.Add path & cPath & "\"
    End If
    cPath = Dir()
Loop
For I = 1 To coll.Count
    fName = Dir(coll.Item(I) & "*.csv")
    ImportData coll.Item(I) & fName
    fName = Dir()
Next
Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Comma:=True
Range("L:L").TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Comma:=True
Range("L:L").Delete
End Sub

 

[NCase]

Hi Chihiro,

This looks good so far Thank you so much for help. I will play around with the macro on other datasets.

At moment, I am still undecided if having one master file that I can then browse to my chosen directory or saving different files of macro in every new directory. It might get tiresome once the data starts cranking out super fast. Is that a big deal to change?

Best,

Francis

 

[Chihiro]

No, it isn't that hard. If you want to pick a folder from single master....
You can use FileDialog(msoFolderPicker) to choose the root folder for all subfolders. Do note that code is meant for single layer depth (i.e. it won't import from subfolder within another subfolder).