VBA To Extract Certain Rows From A Text File

**Bogdan** · 08-30-2013, 02:53 PM

Hello,

I saw some post's on this subject but unfortunately my VBA knowledge is rudimentary.

So below I have a macro that imports a tab delimited text file in excel

Code:

Public Sub ImportTextFile(FName As String, Sep As String)

Dim RowNdx As Long
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer

Application.ScreenUpdating = False

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row

Open FName For Input Access Read As #1

While Not EOF(1)
    Line Input #1, WholeLine
    If Right(WholeLine, 1) <> Sep Then
        WholeLine = WholeLine & Sep
    End If
    ColNdx = SaveColNdx
    Pos = 1

    NextPos = InStr(Pos, WholeLine, Sep)
    While NextPos >= 1
        TempVal = Mid(WholeLine, Pos, NextPos - Pos)
        Cells(RowNdx, ColNdx).Value = TempVal
        Pos = NextPos + 1
        ColNdx = ColNdx + 1
        NextPos = InStr(Pos, WholeLine, Sep)
    Wend
    RowNdx = RowNdx + 1
Wend

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1
End Sub

Code:

Sub DoTheImport()

    Dim Position As Variant
    Dim Separator As String
    Dim FileName As Variant
    Dim Sep As String
    FileName = Application.GetOpenFilename(FileFilter:="Text File (*.txt),*.txt")
    If FileName = False Then

        Exit Sub
    End If

Separator = vbTab

    Debug.Print "FileName: " & FileName, "Separator: " & Sep
    ImportTextFile FName:=CStr(FileName), Sep:=Separator
End Sub

the problem is that i need only certain rows/columns.
At the the moment i do the formatting manually and would really appreciate some help with adding these features to the macro, or creating a new one.

For Rows I was thinking about 2 solutions:
1. To determine by user input the 1st and last row needed, then get only the data in that range.
2. To read from an Excel sheet the required values, search them and if found copy the entire row. (This would be preferred)

For Columns it's a lot easier as i only need columns B,C,F,G out of columns A to H. If it can be added in the code very well, if not i can do it manually.

Thanks.

**Admin** · 08-30-2013, 03:25 PM

Hi Bogdan,

Welcome to ExcelFox!

The best would be record a macro while importing the data manually. You have the option which columns of data you want while importing the data manually. Once the macro is recorded, we can customise that if required.

**Bogdan** · 08-30-2013, 07:50 PM

Sorry for the delay, wasn't expecting feedback so soon.

Here is the record requested:

Code:

Sub Macro1()
'
' Macro1 Macro
'

'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\bszoverdffy\Desktop\New folder\dsadas.txt", Destination:=Range _
        ("$A$1"))
        .Name = "dsadas"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
End Sub

I also recorded an macro with the entire selection process:

Code:

Sub Macro3()
'
' Macro3 Macro
'

'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\bszoverdffy\Desktop\New folder\dsadas.txt", Destination:=Range _
        ("$A$1"))
        .Name = "dsadas_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Rows("1:1").Select
    Rows("1:1751").Select
    Selection.Delete Shift:=xlUp

    Rows("771:789").Select
    Selection.Delete Shift:=xlUp
End Sub

I've also tried to get the required rows using Excel functions.

Code:

Sub Macro2()
'
' Macro2 Macro
'

'
    Selection.FormulaR1C1 = "=VLOOKUP(Sheet2!R1C1,Sheet1!C[-1]:C[2],2,0)"
    Range("C1").Select
    Selection.FormulaR1C1 = "=VLOOKUP(Sheet2!R1C1,Sheet1!C[-1]:C[2],3,0)"
End Sub

the problem with this is that for some reason vlookup only works for the highlighted part, the rest of columns/rows I get N/A

**Admin** · 08-31-2013, 02:12 PM

Hi

You can use this code to import the text file. Not sure about the formula. In which range you want the formula ?

Code:

Sub Macro3()
        
    Dim nm  As Name
    
    For Each nm In ThisWorkbook.Names
        If nm.Name Like "dsadas*" Then nm.Delete
    Next
        
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\bszoverdffy\Desktop\New folder\dsadas.txt", Destination:=Range _
        ("$A$1"))
        .Name = "dsadas_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
    Range("b:b,c:c,f:g").EntireColumn.Delete
    
    Rows("1:1751").Delete Shift:=xlUp
    Rows("771:789").Delete Shift:=xlUp
    
    
End Sub