Extract the data from Text file
Public OutputWkb As Workbook, TxtWkb As Workbook, sh As Worksheet
Sub DataExtractFromTextFile()
DefineOutputwkb
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
SelectTextfile
TextFile.Show
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()
Dim filename As String
filename = Application.GetOpenFilename()
Workbooks.OpenText filename:=filename, StartRow:=1, DataType:=xlDelimited, Comma:=True
DefineTxtWkb
Set sh = TxtWkb.ActiveSheet
End Function
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