Extract the data from Text file

     

    Download The Workbook

     

     

     

    Public OutputWkb As Workbook, TxtWkb As Workbook, sh As Worksheet
    Sub DataExtractFromTextFile()
    'Define the coding workbook which is active workbook
    DefineOutputwkb

    'Visible Properties of Userform
    TextFile.ListBox1.Visible = False
    TextFile.CommandButton1.Visible = False
    TextFile.CommandButton2.Visible = False
    TextFile.CommandButton3.Visible = False
    TextFile.Label2.Visible = False
    TextFile.ListBox2.Visible = False
    TextFile.Label3.Visible = False
    TextFile.ComboBox2.Visible = False
    TextFile.Label4.Visible = False
    TextFile.TextBox1.Visible = False
    TextFile.ListBox3.Visible = False

    'Select the Textfile
    SelectTextfile

    'Display the Userform
    TextFile.Show

    'Format the Output
    Format_TheData
    MsgBox "Hi Process Completed"
    End Sub

     

     

     

    Function Format_TheData()
    LastRow = OutputWkb.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    LastCol = OutputWkb.ActiveSheet.Range("A1").End(xlToRight).Column

    With OutputWkb.ActiveSheet.Range(Cells(1, 1), Cells(LastRow, LastCol))
    .Font.Size = 13
    .Font.Name = "Estrangelo Edessa"
    .Rows(1).Interior.ColorIndex = 9
    .Rows(1).HorizontalAlignment = xlCenter
    .Rows(1).Font.Bold = True
    .Rows(1).Font.ColorIndex = 2
    .Cells.Borders.ColorIndex = 1
    .Cells.Borders.LineStyle = xlContinuous
    .ColumnWidth = 11

    End With

    End Function

     

     

    Function DefineOutputwkb()
    Set OutputWkb = ActiveWorkbook
    End Function

     

     

    Function DefineTxtWkb()
    Set TxtWkb = ActiveWorkbook
    End Function
    Function SelectTextfile()

    'Using Getopenfilename method of application object
    Dim filename As String
    filename = Application.GetOpenFilename()

    'Select the workbook
    Workbooks.OpenText filename:=filename, StartRow:=1, DataType:=xlDelimited, Comma:=True

    'Define the textworkbook
    DefineTxtWkb

    'Consider the active sheet against the variable of Sh
    Set sh = TxtWkb.ActiveSheet
    End Function

     

     

     

    Coding in Userform:

    Private Sub UserForm_Initialize()
    'Using Initialize event of Userform
    'Entering the Options in combobox of userform

    TextFile.Width = 315
    TextFile.Height = 200
    TextFile.ComboBox1.AddItem "Entire Data"
    TextFile.ComboBox1.AddItem "Manual Selection"
    TextFile.ComboBox1.AddItem "Regular Expression"
    End Sub


     

     

    Private Sub CommandButton3_Click()
    ExtractTheDataFromListBox_RegExp
    End Sub

     

     

    Private Sub TextBox1_AfterUpdate()
    'Using after update Event of textbox
    'it is useful to reload the data in listbox based on Regular expression
    Me.ListBox1.Clear
    StrSearch = Me.TextBox1.Value

    ColNumb = Val(Me.ComboBox2.Value)
    rownumb = 0
    'Loop through all the rows of text file
    For R = 2 To sh.Range("A1").CurrentRegion.Rows.Count

    'Using LIKE operator for matched cases
    If UCase(sh.Cells(R, ColNumb)) Like UCase(StrSearch) Then
    Me.ListBox1.AddItem

    'Adding the required columns
    For C = 1 To sh.Range("A1").CurrentRegion.Columns.Count
    Me.ListBox1.List(rownumb, C - 1) = sh.Cells(R, C).Value
    Next
    rownumb = rownumb + 1
    End If
    Next

     

     

     

    Private Sub ComboBox1_Change()
    OutputWkb.ActiveSheet.UsedRange.Clear

    'User selects entire data
    If Me.ComboBox1.Value = "Entire Data" Then
    Unload TextFile
    sh.UsedRange.Copy OutputWkb.ActiveSheet.Range("A1")
    TxtWkb.Close


    'If it is manual selection
    ElseIf Me.ComboBox1.Value = "Manual Selection" Then
    TextFile.Width = 420
    TextFile.Height = 450
    Me.ListBox1.Visible = True
    Me.ListBox1.Width = 360

    Me.Label2.Visible = True
    Me.ListBox2.Visible = True
    LoadDataIntoListBox


    'Extracting through regular expression
    ElseIf Me.ComboBox1.Value = "Regular Expression" Then
    TextFile.Label3.Visible = True
    TextFile.ComboBox2.Visible = True
    TextFile.Label4.Visible = True
    TextFile.TextBox1.Visible = True
    TextFile.Width = 420
    TextFile.Height = 450
    Me.ListBox1.Visible = True
    Me.ListBox1.Width = 360
    Me.ListBox1.Height = 150
    Me.CommandButton1.Visible = True
    Me.CommandButton3.Visible = True
    Me.ListBox3.Visible = True
    WildCartData = "? -- Denotes Single Character" & vbNewLine & "* -- Denotes any number of characters"
    Personal = Array("? -- Single Character", "* -- Any number of characters")
    Me.ListBox3.List = Personal
    LoadDataIntoListBox_RegExp

    End If

    End Sub

     

     

     

     

    Function LoadDataIntoListBox_RegExp()

    'Add the data into listbox in case of regular expression
    Me.ListBox1.ColumnCount = sh.Range("A1").CurrentRegion.Columns.Count
    CWidth = 360 / Me.ListBox1.ColumnCount
    CoWidth = ""
    For CW = 0 To Me.ListBox1.ColumnCount - 1
    CoWidth = CoWidth & CWidth & ";"
    Me.ComboBox2.AddItem Val(CW) + 1
    Next
    CoWidth = Left(CoWidth, Len(CoWidth) - 1)
    Me.ListBox1.ColumnHeads = False
    Me.ListBox1.ColumnWidths = CoWidth
    LastRow = sh.Range("A" & Rows.Count).End(xlUp).Row

    TxtWkb.Activate
    OutputWkb.Activate

    '===================================================
    ' Entry without Headers
    For R = 2 To sh.Range("A1").CurrentRegion.Rows.Count
    Me.ListBox1.AddItem
    For C = 1 To sh.Range("A1").CurrentRegion.Columns.Count
    Me.ListBox1.List(R - 2, C - 1) = sh.Cells(R, C).Value
    Next
    Next
    '======================================================
    End Function

    Function LoadDataIntoListBox()

    Me.ListBox1.ColumnCount = sh.Range("A1").CurrentRegion.Columns.Count
    CWidth = 360 / Me.ListBox1.ColumnCount
    CoWidth = ""
    For CW = 0 To Me.ListBox1.ColumnCount - 1
    CoWidth = CoWidth & CWidth & ";"
    Me.ListBox2.AddItem Val(CW) + 1
    Next
    CoWidth = Left(CoWidth, Len(CoWidth) - 1)
    Me.ListBox1.ColumnHeads = True
    Me.ListBox1.ColumnWidths = CoWidth
    LastRow = sh.Range("A" & Rows.Count).End(xlUp).Row

    Me.ListBox1.RowSource = TxtWkb.ActiveSheet.Range(Cells(2, 1), Cells(LastRow, sh.Range("A1").CurrentRegion.Columns.Count)).Address(True, True)
    OutputWkb.Activate
    Me.CommandButton1.Visible = True
    Me.CommandButton2.Visible = True
    End Function

    Function ExtractTheDataFromListBox_RegExp()
    R = 2:
    For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) Then
    Cnumb = 1
    For C = 0 To Me.ListBox1.ColumnCount - 1
    If FirstHit = "" Then
    OutputWkb.ActiveSheet.Cells(1, Cnumb).Value = sh.Cells(1, C + 1).Value
    End If
    OutputWkb.ActiveSheet.Cells(R, Cnumb).Value = Me.ListBox1.List(i, C)
    Cnumb = Cnumb + 1
    Next C
    R = R + 1
    FirstHit = "Headers Added"
    End If
    Next
    TxtWkb.Close
    Unload TextFile
    End Function

     

     

    Function ExtractTheDataFromListBox()
    R = 2:
    For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) Then
    Cnumb = 1
    For C = 0 To Me.ListBox1.ColumnCount - 1
    If Me.ListBox2.Selected(C) Then
    If FirstHit = "" Then
    OutputWkb.ActiveSheet.Cells(1, Cnumb).Value = sh.Cells(1, C + 1).Value
    End If
    OutputWkb.ActiveSheet.Cells(R, Cnumb).Value = Me.ListBox1.List(i, C)
    Cnumb = Cnumb + 1
    End If
    Next C
    R = R + 1
    FirstHit = "Headers Added"
    End If
    Next


    End Function

    Private Sub CommandButton1_Click()
    ExtractTheDataFromListBox
    Unload TextFile
    TxtWkb.Close
    End Sub

    Private Sub CommandButton2_Click()
    Unload Me
    End Sub