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

Originally Posted by SamT

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

Originally Posted by xboon_95

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

Originally Posted by xboon_95

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?

Thread: Modifying codes to add if-else statement

Thread Tools

Display

Modifying codes to add if-else statement

Posting Permissions