Delete Unwanted Data

I need to import a text file into excel and do the following :

This text file is broken into “Information on object # 1 through #35. In each of these objects I would like to extract the NAME row and SEGMENT LENGTH row and delete the rest. CAN ANY BODY HELP.

Some times these files are 1000's of objects so I need to automate it some how.

Thanks in advance for your help!

--------------------------

Give this a try:

Option Explicit

Sub ImportObjectList()
'Author:    Jerry Beaucaire
'Date:      9/16/2010
'Summary:   Import a text file and extract/format specific data
Dim fName As String
Dim LR As Long

'Select a file
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        .Filters.Add "All Files", "*.*"        'everything
        .Filters.Add "Text Files", "*.txt", 1  'default
        .Show
        If .SelectedItems.Count > 0 Then
            fName = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
Application.ScreenUpdating = False
'Import the file
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fName, _
        Destination:=Range("A1"))
        .Name = "ame--"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("B1:B" & LR).FormulaR1C1 = _
        "=IF(OR(ISNUMBER(SEARCH({""Information on"",""SEGMENT LENGTH""}, RC[-1]))), RC[-1], 1)"
Columns("B:B").Select
    Selection.SpecialCells(xlCellTypeFormulas, 1).Select
    Selection.EntireRow.Delete
    Range("A1").Insert xlShiftDown
    Columns("B:B").Value = Columns("B:B").Value
    Range("A1:B1").Value = [{"OBJECTS","SEGMENT LENGTH"}]
    Columns("B:B").Replace What:="SEGMENT LENGTH = ", Replacement:="", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("A1").AutoFilter Field:=1, Criteria1:="=SEGMENT*"
    Range("A2:A" & LR).EntireRow.Delete xlShiftUp
    Range("A1").AutoFilter
    Range("A1").AutoFilter Field:=2, Criteria1:="=Informa*"
    Range("B2:B" & LR).ClearContents
    ActiveSheet.AutoFilterMode = False
    Columns("A:B").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Range("A1:B1").Font.Bold = True
    Range("A2").Select
    ActiveWindow.FreezePanes = True

Application.ScreenUpdating = True
End Sub

-----------------------------

Yes, this a macro.

How/Where to install the macro:

1. Open up a blank workbook
2. Get into VB Editor (Press Alt+F11)
3. Insert a new module (Insert > Module)
4. Copy and Paste in your code (given above)
5. Get out of VBA (Press Alt+Q)
6. Save as a macro-enabled workbook

The macro is installed and ready to use.

A. Press Alt-F8
B. Select ImportObjectList from the macro list
C. The macro will prompt you to select the text file on your hard drive
D. The macro will do the rest
B.

Try this:

Option Explicit

Sub ImportObjectList()
'Author:    Jerry Beaucaire
'Date:      9/16/2010
'Summary:   Import a text file and extract/format specific data
Dim fName As String
Dim LR As Long

'Select a file
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        .Filters.Add "All Files", "*.*"        'everything
        .Filters.Add "Text Files", "*.txt", 1  'default
        .Show
        If .SelectedItems.Count > 0 Then
            fName = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
'Application.ScreenUpdating = False
'Import the file
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fName, _
        Destination:=Range("A1"))
        .Name = "ame--"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
'Delete unneeded rows
    LR = Range("A" & Rows.Count).End(xlUp).Row
    Range("B1:B" & LR).FormulaR1C1 = _
        "=IF(OR(ISNUMBER(SEARCH({""Name  "",""Information on"",""SEGMENT LENGTH""}, RC[-1]))), RC[-1], 1)"
    Columns("B:B").SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete

'Create new table
    Range("A1").Insert xlShiftDown
    Range("A1:C1").Value = [{"OBJECTS","NAME","SEGMENT LENGTH"}]
    Range("B2:B" & LR).FormulaR1C1 = _
        "=IF(LEFT(RC1,4)=""Info"",TRIM(MID(R[1]C1,6,LEN(R[1]C1))), """")"
    Range("C2:C" & LR).FormulaR1C1 = _
        "=IF(LEFT(RC1,4)=""Info"", TRIM(MID(R[2]C1,FIND(""="",R[2]C1)+2, LEN(R[2]C1)-FIND("" ("",R[2]C1)-2)), """")"
    Columns("B:C").Value = Columns("B:C").Value
    Range("A1").AutoFilter
    Range("A1").AutoFilter Field:=2, Criteria1:="="
    Range("A2:C" & LR).EntireRow.Delete xlShiftUp
    ActiveSheet.AutoFilterMode = False
    
    On Error Resume Next
        Columns("A:C").SpecialCells(xlCellTypeConstants, 16).ClearContents
    On Error GoTo 0

    Columns("A:C").EntireColumn.AutoFit
    Range("A1:C1").Font.Bold = True
    Range("A2").Select
    ActiveWindow.FreezePanes = True

Application.ScreenUpdating = True
End Sub