Hello,

I have a requirement. The below is a text file data.

In this, I have to ignore the lines starting with HEAD and count the number of lines starting with DET for each data group.

Eg. Count of PersonAddress data group is 2, Count of PersonEmail data group is 2, Count of PersonEmail data group is 2.

I require a Excel VBA code to read line by line and fetch the count of each data group ignoring the lines starting with HEAD. Thanks in advance.

HEAD|PersonAddress|AddressType|AddressLine1|AddressLine2|AddressLine3|TownOrCity|Region1|Region2|Region3|Country|PostalCode\n\nDET|PersonAddress|HOME|1234 Cabrera Hill Lane|#NULL|#NULL|aabbcc|Fort Bend|TX|#NULL|US|77494\n\nDET|PersonAddress|HOME|1234 Cabrera Hill Lane|#NULL|#NULL|aabbcc|Fort Bend|TX|#NULL|US|77494\n\nHEAD|PersonEmail|EmailType|EmailAddress\n\nDET|PersonEmail|W1|email address removed for privacy reasons\n\nDET|PersonEmail|W1|email address removed for privacy reasons\n\nHEAD|PersonPhone|PhoneType|CountryCodeNumber|AreaCode|PhoneNumber\n\nDET|PersonPhone|HM|1|123|45678\n\nDET|PersonPhone|HM|1|123|45678

Hello,

I have a requirement. The below is a text file data.

In this, I have to ignore the lines starting with HEAD and count the number of lines starting with DET for each data group.

Eg. Count of PersonAddress data group is 2, Count of PersonEmail data group is 2, Count of PersonEmail data group is 2.

I require a Excel VBA code to read line by line and fetch the count of each data group ignoring the lines starting with HEAD. Thanks in advance.

learnerjane 

I realise this is not an answer to the OP but, since HansVogelaar has written a significant block of VBA, I set out to see whether a similar result could be obtained using worksheet formulae.  The worst limitation is that most Lambda functions do not work correctly with 'nested arrays' which is something of a pain when the whole purpose of the calculation is to create an array of arrays.  Nevertheless, in this case

CountByTypeλ = LAMBDA(aLines,\n    LET(\n        type,     MAP(aLines,IdentifyTypeλ),\n        filtered, FILTER(type, ISTEXT(type)),\n        distinct, UNIQUE(filtered),\n        count,    MAP(distinct, LAMBDA(type, COUNT(IF(filtered = type, 1)))),\n        HSTACK(distinct, count)\n    )\n);\n\nIdentifyTypeλ = LAMBDA(aLine,\n    LET(\n        split, IFERROR(TEXTSPLIT(aLine, \"|\"), \"HEAD\"),\n        IF(INDEX(split, 1, 1) <> \"HEAD\", INDEX(split, 1, 2))\n    )\n);

My thought on this are, whilst Lambda functions to not replace either VBA or DAX, they are capable of making significant inroads for problems of modest dimension.

Note: the formula requires the text file to be imported to Excel which is not what was requested.  Power query would probably be my tool of choice for the data import.

learnerjane 

Here you go.

Sub ProcessTextFile()\n    Dim sFile As String\n    Dim f As Integer\n    Dim sLines As String\n    Dim aLines() As String\n    Dim aLine() As String\n    Dim i As Long\n    Dim n As Long\n    Dim sTitle As String\n    ' *** Change sFile to the correct path and filename ***\n    sFile = \"Test.txt\"\n    f = FreeFile\n    Open sFile For Input As #f\n    sLines = Input(LOF(f), #f)\n    Close #f\n    aLines = Split(sLines, vbCrLf)\n    For i = 0 To UBound(aLines)\n        If aLines(i) <> \"\" Then\n            aLine = Split(aLines(i), \"|\")\n            Select Case aLine(0)\n                Case \"HEAD\"\n                    If n > 0 Then\n                        Debug.Print \"Group \" & sTitle & \" has \" & n & \" items\"\n                    End If\n                    sTitle = aLine(1)\n                    n = 0\n                Case \"DET\"\n                    n = n + 1\n            End Select\n        End If\n    Next i\n    Debug.Print \"Group \" & sTitle & \" has \" & n & \" items\"\nEnd Sub

HansVogelaar below is the code which I modified to print the output in excel columns. Tried various things but in vain. Could you please help in getting the output like the one in the attached image? Note that I'm selecting multiple text files to read.

Current output:

Issue: The file name in second row should be test-Copy.dat

Desired Output:

Code:

FileToOpen = Application.GetOpenFilename _\n    (Filefilter:=\"HDL Files (*.dat), *.dat\", Title:=\"Select HDL Files\", MultiSelect:=True)\n    \n    r = 2\n    If IsArray(FileToOpen) Then\n        For FileCnt = 1 To UBound(FileToOpen)\n            Filename = fso.getfilename(FileToOpen(FileCnt))\n            f = FreeFile\n            Open FileToOpen(FileCnt) For Input As #f\n            sLines = Input(LOF(f), #f)\n            Close #f\n            \n            If InStr(sLines, vbCrLf) Then\n                delim = vbCrLf\n            ElseIf InStr(sLines, vbLf) Then\n                delim = vbLf\n            End If\n            \n            aLines = Split(sLines, delim)\n            \n            For i = 0 To UBound(aLines)\n                If aLines(i) <> \"\" Then\n                    aLine = Split(aLines(i), \"|\")\n                    Select Case aLine(0)\n                        Case \"HEAD\"\n                            If n > 0 Then\n                                'r = r + 1\n                                Debug.Print \"File Count: \" & FileCnt\n                                Debug.Print r & \"row\"\n                                Debug.Print \"In \" & Filename & \", Group \" & sTitle & \" has \" & n & \" items\"\n                                With shHDLRecordCountReport\n                                    .Range(\"A\" & r).Value = Filename\n                                    .Range(\"B\" & r).Value = sTitle\n                                    .Range(\"C\" & r).Value = n\n                                    .UsedRange.Columns.AutoFit\n                                End With\n                                r = r + 1\n                            End If\n                            sTitle = aLine(1)\n                            n = 0\n                        Case \"DET\"\n                            n = n + 1\n                    End Select\n                End If\n            Next i\n            Debug.Print \"Bottom\"\n            Debug.Print \"File Count: \" & FileCnt\n            Debug.Print r & \"row\"\n            Debug.Print \"In \" & Filename & \", Group \" & sTitle & \" has \" & n & \" items\"\n            With shHDLRecordCountReport\n                .Range(\"A\" & r).Value = Filename\n                .Range(\"B\" & r).Value = sTitle\n                .Range(\"C\" & r).Value = n\n                .UsedRange.Columns.AutoFit\n            End With\n        Next FileCnt\n        MsgBox \"Report is ready\", vbInformation, \"Good Job\"\n    End If

learnerjane 

Does this do what you want?

    FileToOpen = Application.GetOpenFilename _\n       (Filefilter:=\"HDL Files (*.dat), *.dat\", Title:=\"Select HDL Files\", MultiSelect:=True)\n    \n    r = 1\n    If IsArray(FileToOpen) Then\n        For FileCnt = 1 To UBound(FileToOpen)\n            FileName = FSO.GetFileName(FileToOpen(FileCnt))\n            f = FreeFile\n            Open FileToOpen(FileCnt) For Input As #f\n            sLines = Input(LOF(f), #f)\n            Close #f\n            \n            If InStr(sLines, vbCrLf) Then\n                delim = vbCrLf\n            ElseIf InStr(sLines, vbLf) Then\n                delim = vbLf\n            End If\n            \n            aLines = Split(sLines, delim)\n            \n            For i = 0 To UBound(aLines)\n                If aLines(i) <> \"\" Then\n                    aLine = Split(aLines(i), \"|\")\n                    Select Case aLine(0)\n                        Case \"HEAD\"\n                            If n > 0 Then\n                                r = r + 1\n                                Debug.Print \"File Count: \" & FileCnt\n                                Debug.Print r & \"row\"\n                                Debug.Print \"In \" & FileName & \", Group \" & sTitle & \" has \" & n & \" items\"\n                                With shHDLRecordCountReport\n                                    .Range(\"A\" & r).Value = FileName\n                                    .Range(\"B\" & r).Value = sTitle\n                                    .Range(\"C\" & r).Value = n\n                                    .UsedRange.Columns.AutoFit\n                                End With\n                            End If\n                            sTitle = aLine(1)\n                            n = 0\n                        Case \"DET\"\n                            n = n + 1\n                    End Select\n                End If\n            Next i\n            r = r + 1\n            Debug.Print \"Bottom\"\n            Debug.Print \"File Count: \" & FileCnt\n            Debug.Print r & \"row\"\n            Debug.Print \"In \" & FileName & \", Group \" & sTitle & \" has \" & n & \" items\"\n            With shHDLRecordCountReport\n                .Range(\"A\" & r).Value = FileName\n                .Range(\"B\" & r).Value = sTitle\n                .Range(\"C\" & r).Value = n\n                .UsedRange.Columns.AutoFit\n            End With\n            n = 0\n        Next FileCnt\n        MsgBox \"Report is ready\", vbInformation, \"Good Job\"\n    End If