Hi all, 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:
Any help is appreciated, thank you
Code:
Private Sub CommandButton2_Click()
If WorksheetFunction.DCountA(Sheets("1").Cells, "A", " Times") = 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
End With
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 keyPhrase As String
Dim topCell As Range, bottomCell As Range
Dim dataCells As Variant
Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet keyPhrase = " Time"
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
End With
Else MsgBox "File is not loaded."
End If
End If
End SubAny help is appreciated, thank you