xboon_95
10-14-2014, 06:25 PM
Hi guys, I am required to import my text file into Excel and first, it will search for the string " Time". This string is unique and each string of " Time" represents a new set of data. Then, if there is more than 1 string of " Time", it will automatically separate the set of data into different sheets. However, if there is only 1 string of " Time", it will only import the text file without the separation. The problem I'm facing now is that I am not able to add an if-else statement into this situation. My codes are as shown below:
Private Sub CommandButton4_Click()
MsgBox "Please select your desired text file"
If keyPhrase = " Time" And keyPhrase > 1 Then
Dim varFileName
varFileName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If TypeName(varFileName) = "String" Then
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & varFileName _
, Destination:=Range("A1"))
.Name = "AddEmployee"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=True
Dim keyPhrase As String
Dim topCell As Range, bottomCell As Range
Dim dataCells As Variant
Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet
Application.ScreenUpdating = False
With sourceSheet.Columns(1)
Set bottomCell = .Cells(.Rows.Count, 1).End(xlUp)
Set topCell = .Find(keyPhrase, After:=bottomCell, SearchDirection:=xlPrevious, LookAt:=xlWhole)
Do Until (topCell Is Nothing)
If (bottomCell.Row < topCell.Row) Then Exit Do
With .Parent.Parent
With .Worksheets.Add(After:=.Sheets(.Sheets.Count), Type:=xlWorksheet)
Range(topCell, bottomCell).EntireRow.Copy Destination:=.Range("A1")
End With
End With
Set bottomCell = topCell.End(xlUp)
Set topCell = .Find(keyPhrase, After:=bottomCell, SearchDirection:=xlPrevious, LookAt:=xlWhole)
Loop
End With
Application.ScreenUpdating = True
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Worksheets
If Application.CountA(ws.Cells) = 0 Then ws.Delete
Next ws
Application.DisplayAlerts = True
Application.DisplayAlerts = False 'deleting sheet 1
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete
Dim strFileFullName As String
strFileFullName = varFileName
Range("r7").Select
ActiveCell.FormulaR1C1 = strFileFullName
TextBox2.Text = ActiveSheet.Range("r7").Value
MsgBox "File loaded."
End With
Else
MsgBox "File is not loaded."
End If
Else
varFileName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If TypeName(varFileName) = "String" Then
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & varFileName _
, Destination:=Range("A1"))
.Name = "AddEmployee"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=True
'Dim ws As Worksheet
'Application.DisplayAlerts = False
'For Each ws In ActiveWorkbook.Worksheets
'If Application.CountA(ws.Cells) = 0 Then ws.Delete
'Next ws
'Application.DisplayAlerts = True
'Application.DisplayAlerts = False 'deleting sheet 1
'Sheets("ActiveSheet").Select
'ActiveWindow.SelectedSheets.Delete
End If
End Sub
Firstly it searches for keyPhrase, which is the unique string " Time". If there are more than 1 string, the set of data will be separated and it will not be separated if there is only 1 string. I suspect that the problem lies in the code "keyPhrase > 1" but I am not sure how to change it. Any help here? :(
Private Sub CommandButton4_Click()
MsgBox "Please select your desired text file"
If keyPhrase = " Time" And keyPhrase > 1 Then
Dim varFileName
varFileName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If TypeName(varFileName) = "String" Then
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & varFileName _
, Destination:=Range("A1"))
.Name = "AddEmployee"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=True
Dim keyPhrase As String
Dim topCell As Range, bottomCell As Range
Dim dataCells As Variant
Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet
Application.ScreenUpdating = False
With sourceSheet.Columns(1)
Set bottomCell = .Cells(.Rows.Count, 1).End(xlUp)
Set topCell = .Find(keyPhrase, After:=bottomCell, SearchDirection:=xlPrevious, LookAt:=xlWhole)
Do Until (topCell Is Nothing)
If (bottomCell.Row < topCell.Row) Then Exit Do
With .Parent.Parent
With .Worksheets.Add(After:=.Sheets(.Sheets.Count), Type:=xlWorksheet)
Range(topCell, bottomCell).EntireRow.Copy Destination:=.Range("A1")
End With
End With
Set bottomCell = topCell.End(xlUp)
Set topCell = .Find(keyPhrase, After:=bottomCell, SearchDirection:=xlPrevious, LookAt:=xlWhole)
Loop
End With
Application.ScreenUpdating = True
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Worksheets
If Application.CountA(ws.Cells) = 0 Then ws.Delete
Next ws
Application.DisplayAlerts = True
Application.DisplayAlerts = False 'deleting sheet 1
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete
Dim strFileFullName As String
strFileFullName = varFileName
Range("r7").Select
ActiveCell.FormulaR1C1 = strFileFullName
TextBox2.Text = ActiveSheet.Range("r7").Value
MsgBox "File loaded."
End With
Else
MsgBox "File is not loaded."
End If
Else
varFileName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If TypeName(varFileName) = "String" Then
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & varFileName _
, Destination:=Range("A1"))
.Name = "AddEmployee"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=True
'Dim ws As Worksheet
'Application.DisplayAlerts = False
'For Each ws In ActiveWorkbook.Worksheets
'If Application.CountA(ws.Cells) = 0 Then ws.Delete
'Next ws
'Application.DisplayAlerts = True
'Application.DisplayAlerts = False 'deleting sheet 1
'Sheets("ActiveSheet").Select
'ActiveWindow.SelectedSheets.Delete
End If
End Sub
Firstly it searches for keyPhrase, which is the unique string " Time". If there are more than 1 string, the set of data will be separated and it will not be separated if there is only 1 string. I suspect that the problem lies in the code "keyPhrase > 1" but I am not sure how to change it. Any help here? :(