VBA To Extract Certain Rows From A Text File

[Bogdan]

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


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




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]

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]

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

Here is the record requested:


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:


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.


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]

Hi

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


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

[Bogdan]

I figured out how to solve the range problem using Excel functions. Thank you for the help.