Quote Originally Posted by jindon View Post
Different method
Sub test()
    Dim myDir As String, fn, e, txt, a() As String, n As Long, dic As Object
    Dim myName As String, mtch As Object, m As Object
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1) & "\"
    End With
    If myDir = vbNullString Then Exit Sub
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    ReDim a(1 To 1000, 1 To 100): n = 1: a(n, 1) = "File name"
    With CreateObject("VBScript.RegExp")
        .Global = True
        fn = Dir(myDir & "\*.txt")
        Do While fn <> ""
            txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(myDir & fn).ReadAll
            n = n + 1: a(n, 1) = CreateObject("Scripting.FileSystemObject").GetBaseName(fn)
            .Pattern = "(.+?:)[\r\n]*((.*\r\n)+?)[\r\n]*(?=\-+)"
            Set mtch = .Execute(txt)
            For Each m In mtch
                myName = m.submatches(0)
                If Not dic.exists(myName) Then
                    dic(myName) = dic.Count + 2
                    If UBound(a, 2) < dic.Count + 1 Then
                        ReDim Preserve a(1 To UBound(a, 1), 1 To UBound(a, 2) + 100)
                    End If
                    a(1, dic(myName)) = myName
                End If
                .Pattern = "[\r\n]+$"
                a(n, dic(myName)) = .Replace(m.submatches(1), "")
            Next
            fn = Dir
        Loop
    End With
    Cells(1).Resize(n, dic.Count + 1) = a
End Sub
Thanks a lot jindon! It's working perfectly.
But my bad there are some portions where the data is like,
EGN: xxx
Hug: xxxxx

In this case I need the header as EGN and paste the data Xxx in the row.

As the code works only if there is ----- these sort of data's are not captured. Sorry for missing on this. Please help me on this...