PDA

View Full Version : Modifying codes to add if-else statement



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? :(

Bob Phillips
10-14-2014, 11:46 PM
A variable cannot be equal to a string value and and also greater than a number, they are different data types, you cannot test for both. How does KeyPhrase get set, what is the value, how does that procedure get called.

xboon_95
10-15-2014, 02:44 AM
Hey! Thanks for telling me that, I am still a newbie in this :/ keyPhrase is the unique string I'm finding for, which is " Time". After getting keyPhrase, my program should be able to check how many keyPhases are there in the text file. Each keyPhrase represents a new set of data and thus it will be separated to a new sheet. If there is only 1 keyPhrase, there will not be any separation of sheets. I was thinking of using select case but I'm not sure how to implement it. Any idea?

SamT
10-15-2014, 05:41 AM
I see a lot of problems with that procedure, I would use the FileDialog(msoFileDialogFilePicker) to get the file name and the OpenText Method to open the Text file in a new workbook and work only on that book's single worksheet.

In any Case, all " Time"s should be in the same column on the sheet.

However, for your If...Then...Else

If WorksheetFunction.DCountA(Sheets("X").Cells, "TimesColumn", " Times") = 1 Then
'Save the book
Else
'Separate the data
'Save the book
End If

xboon_95
11-02-2014, 05:37 AM
I see a lot of problems with that procedure, I would use the FileDialog(msoFileDialogFilePicker) to get the file name and the OpenText Method to open the Text file in a new workbook and work only on that book's single worksheet.

In any Case, all " Time"s should be in the same column on the sheet.

However, for your If...Then...Else

If WorksheetFunction.DCountA(Sheets("X").Cells, "TimesColumn", " Times") = 1 Then
'Save the book
Else
'Separate the data
'Save the book
End If


Hey! I tried this code but it doesn't seem to work :(


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


Dim strFileFullName As String
strFileFullName = varFileName
Range("r7").Select
ActiveCell.FormulaR1C1 = strFileFullName
TextBox2.Text = ActiveSheet.Range("r7").Value


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


Application.DisplayAlerts = False 'deleting sheet 1
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete


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

End If
End Sub

xboon_95
11-03-2014, 05:36 PM
Hey! I tried this code but it doesn't seem to work :(


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


Dim strFileFullName As String
strFileFullName = varFileName
Range("r7").Select
ActiveCell.FormulaR1C1 = strFileFullName
TextBox2.Text = ActiveSheet.Range("r7").Value


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


Application.DisplayAlerts = False 'deleting sheet 1
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete


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

End If
End Sub


Any help here? :(

xboon_95
11-10-2014, 06:45 PM
Hey! I tried this code but it doesn't seem to work :(


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


Dim strFileFullName As String
strFileFullName = varFileName
Range("r7").Select
ActiveCell.FormulaR1C1 = strFileFullName
TextBox2.Text = ActiveSheet.Range("r7").Value


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


Application.DisplayAlerts = False 'deleting sheet 1
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete


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

End If
End Sub


Any help here? :(