Results 1 to 12 of 12
  1. #1
    Join Date
    Mar 2004
    Location
    Minnesota, USA, Earth
    Posts
    65

    Unanswered: Deleting extraneous rows in text file

    Hi,

    I know there's a way to do this faster (For Each row?) but my VBA knowledge is lacking in this area (as well in other areas, but I digress).

    There is a report that I have printed to a generic text printer (there is no other way to get this data) and I am parsing it for the data I need. However, I need to delete useless rows. I am presently importing the report entirely into Column A and parsing out what I need after I delete useless rows.

    Here is the code I have that works, but deleting the rows are painfully slow.

    Any help would be greatly appreciated!
    Thanks!
    -Mike

    Range("A31").Select
    Application.ScreenUpdating = False
    Do
    Select Case Left(ActiveCell, 4)
    Case " Run", "Run ", "", "Item", "Code", "----", "====", "TOTA"
    ActiveCell.EntireRow.Delete shift:=xlUp
    Case "Loca"
    intLoc = Mid(ActiveCell, 13, 2)
    ActiveCell.EntireRow.Delete shift:=xlUp
    Case Else
    ActiveCell.Offset(0, 1) = intLoc 'Add location # to column B
    ActiveCell.Offset(1, 0).Select
    End Select
    Loop Until Left(ActiveCell, 3) = "***"
    Application.ScreenUpdating = True

  2. #2
    Join Date
    Oct 2003
    Posts
    1,091
    Here is some code, but not sure if it will be faster. It allows you to select one criteria at a time.

    Code:
    Sub DeleteCriteria()
        Dim n As Long, LastRow As Long, RowCt As Long
        Dim ty As String, myCrit As String
        Dim C As Integer
        LastRow = Range("B" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
        myCrit = InputBox("Criteria?")
        ' column to find criteria
        C = InputBox("What is Column Number")
        For n = LastRow To 2 Step -1
            ty = Cells(n, C)
            Select Case ty
            Case myCrit
                Rows(n).EntireRow.Delete
            End Select
        Next n
    Application.ScreenUpdating = True
    End Sub
    (Note: If you use the [ code ] tags - without spaces, then it makes your code easier to read)
    old, slow, and confused
    but at least I'm inconsistent!

    Rich
    (retired Excel 2003 user, 3/28/2008)

    How to ask a question on forums

  3. #3
    Join Date
    Oct 2003
    Posts
    1,091
    Another option if you are going to do this alot, is to use a two step process. I have used/modified an ultra fast FIND/REPLACE (150+ items in 30,000 rows in less than 3 secs). You could set up a table in another workbook, with these items for replacement as Column A, and Column B blank. Then when you run the macro, it will replace all five of these with blanks. Then you can use the following code to delete based on blanks.

    Code:
    Sub DeleteEmptyRowsMain()
    ' allows user to choose the column by selecting it.
        Dim myColm As Range
        Set myColm = Application.InputBox("Choose column(s) to clear", Type:=8)
        On Error Resume Next
        myColm.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End Sub
    If you want more on this I can provide the link.
    old, slow, and confused
    but at least I'm inconsistent!

    Rich
    (retired Excel 2003 user, 3/28/2008)

    How to ask a question on forums

  4. #4
    Join Date
    Mar 2004
    Location
    Minnesota, USA, Earth
    Posts
    65

    Thanks Shades!

    Thanks Shades! I'll give those a try.
    -Mike

  5. #5
    Join Date
    Jan 2004
    Location
    Aberdeen, Scotland
    Posts
    1,067
    Quote Originally Posted by shades
    Another option if you are going to do this alot, is to use a two step process. I have used/modified an ultra fast FIND/REPLACE (150+ items in 30,000 rows in less than 3 secs). You could set up a table in another workbook, with these items for replacement as Column A, and Column B blank. Then when you run the macro, it will replace all five of these with blanks. Then you can use the following code to delete based on blanks.

    Code:
    Sub DeleteEmptyRowsMain()
    ' allows user to choose the column by selecting it.
        Dim myColm As Range
        Set myColm = Application.InputBox("Choose column(s) to clear", Type:=8)
        On Error Resume Next
        myColm.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End Sub
    If you want more on this I can provide the link.
    ah the old find and replace method i use that one too,
    but i seem to remember getting a ticking off about that a while ago,

    now for the real point
    if you are going to use
    myColm.SpecialCells(xlCellTypeBlanks).EntireRow.De lete
    it might be an idea to sort your data first as it can fail badly over non continuous ranges (i forget but i think at 8000 different ranges it fails)

    All the best
    Dave

  6. #6
    Join Date
    Oct 2003
    Posts
    1,091
    I have deleted as many as 20,000 intermittent rows of blanks in 40,000 row range and not had a problem (about 20 seconds to do it).
    old, slow, and confused
    but at least I'm inconsistent!

    Rich
    (retired Excel 2003 user, 3/28/2008)

    How to ask a question on forums

  7. #7
    Join Date
    Mar 2004
    Location
    Minnesota, USA, Earth
    Posts
    65

    Thanks for the help

    Thanks for the help guys.

    My remaining issue is that I have other rows which are not blank, but contain page headers (Item #, Item Description, Page #, etc.) which are extraneous.

    Any suggestions other than using Select Case to identify the extraneous rows?

    Thanks!
    -Mike

  8. #8
    Join Date
    Oct 2003
    Posts
    1,091
    How often will you be doing this? Daily? If so, I have an even faster, more complicated (setup) way of doing it.
    old, slow, and confused
    but at least I'm inconsistent!

    Rich
    (retired Excel 2003 user, 3/28/2008)

    How to ask a question on forums

  9. #9
    Join Date
    Mar 2004
    Location
    Minnesota, USA, Earth
    Posts
    65

    Daily or every other day at a minimum

    Daily or every other day at a minimum... except the 2nd Tuesday of each week...

  10. #10
    Join Date
    Oct 2003
    Posts
    1,091
    Okay, you asked for it - except on the 2nd Tuesday of each week.

    First, make a spreadsheet named UltraReplace, and put it in a new folder called myFolder (within Documents and Settings). Name the first worksheet of this XL file to ChgA. In column A, cell A1 put a header name (i.e., OrigName), then in A2 and below put all of those items that you want to delete. In cell B1 put a header name (i.e., NewName). But leave the rest of column B cells empty.

    Second, put this code into a module in UltraReplace. If you go to Tools > Macro > Visual basic Editor, it will open the VBE Window. On the left is Project Explorer, and you should see the UltraReplace workbook. Click on it (once) and then go to Insert > Module. A new window will appear on the right side. Then paste the following code into that window.

    Code:
    Sub ChgA() 
         ' TommyBak developed this on mrexcel.com
         ' requires MS Scripting Runtime (In VBE Window Tools > Reference)
         ' this code is actually in the UltraReplace.xls file already
        Dim dctCompany As New Dictionary 
        Dim rgReplace As Range 
        Dim vaReplace As Variant 
        Dim C As Range, x As Long, LastRow As Long 
        Dim IndexCol As Range 
         
        Set IndexCol = Application.InputBox(prompt:="Point out the header in the column for replacement", Type:=8) 
        LastRow = Cells(65536, IndexCol.Column).End(xlUp).Row 
        Set rgReplace = Range(IndexCol.Offset(1, 0), Cells(LastRow, IndexCol.Column)) 
         
        With ThisWorkbook.Sheets("ChgA") 
            For Each C In .Range("A2:A" & .Range("A65536").End(xlUp).Row) 
                dctCompany.Add Key:=CStr(C.Value), Item:=CStr(C.Offset(0, 1).Value) 
            Next 
        End With 
         
        vaReplace = rgReplace 
         
        For x = 1 To UBound(vaReplace, 1) 
            If dctCompany.Exists(vaReplace(x, 1)) = True Then vaReplace(x, 1) = dctCompany.Item(vaReplace(x, 1)) 
        Next 
         
        rgReplace = vaReplace 
         
        Set dctCompany = Nothing 
        Set rgReplace = Nothing 
        Set vaReplace = Nothing 
    End Sub
    While still in VBE, go to the menu Tools > Reference, in the resulting dialog box, on the left, scroll down to find "MS Scripting Runtime". and then check the box next to it.

    Now on the left in the VBE Window, you should have a "Personal.xls" workbook. Click on it. And Insert > Module, and put this code into that new module:

    Code:
    Sub OpenUltraReplace() 
         ' Opens UltraReplace.xls
        ChDir "C:\Documents and Settings\myFolder" 
        Workbooks.Open Filename:= _ 
        "C:\Documents and Settings\myFolder\UltraReplace.xls" 
        ActiveWindow.ActivateNext 
    End Sub
    This code allows you to open the UltraReplace at any time in Excel, put it in the background, and then allow you to use the Replace feature.

    Close the VBE Window and go back to Excel. Now, you have make sure that UltraReplace is in the background, and the workbook that you want to get rid of the items is active. Go to Tools > Macro > Macros choose the macro "UltraReplace!ChgA" (or it may appear as just "ChgA") and click Run. This will bring up a dialog box, in which you select the header cell for the column. In this case, select cell A1 and click OK. This will change all the names in column A based on the Column B values in worksheet ChgA of UltraReplace.xls. (In this case, it will put in blanks. Then use the Delete Blanks macro above.

    If this works, you want to put a menu item to easily access this workbook. Right-click the toolbars and choose Customize. Then on the left scroll down to New Menu Item (last one) and in the right window drag a blank "New Menu Item" to the menu bar (I name it Replace) - this item does nothing except dropdown to the other menu items. Then drag another New Menu Item and put it as a submenu under Replace Menu and assign the macro (OpenUltraReplace) to it. This will open the UltraReplace.xls file. While UltraReplace is still open, assign the macro in UltraReplace.xls (ChgA) to a submenu as well. Once UltraReplace.xls is open, then these macros will run the code to actually replace items. As you add more worksheets and more code, you can add to this menu.

    Be sure to quit Excel and when it asks if you want to save the changes to Personal.xls click YES.


    The beauty of this approach is that I have 15 worksheets in this Replace Workbook (replacing City names to be consistent, companies, people, etc.). And I add code for each worksheet. And you can use another column to make changes.

    It is unbelieveably fast. I use many times every day.

    HTH
    old, slow, and confused
    but at least I'm inconsistent!

    Rich
    (retired Excel 2003 user, 3/28/2008)

    How to ask a question on forums

  11. #11
    Join Date
    Oct 2003
    Posts
    1,091
    If you want a sample go to VBAX (you may have to register).

    UltraReplace Sample
    old, slow, and confused
    but at least I'm inconsistent!

    Rich
    (retired Excel 2003 user, 3/28/2008)

    How to ask a question on forums

  12. #12
    Join Date
    Mar 2004
    Location
    Minnesota, USA, Earth
    Posts
    65

    Careful what you ask for!

    Yikes! I should be careful what I ask for!

    Thanks for the code and instructions. When I get a chance I'll give it whirl and see what else I can corrupt. Unfortunately, I can only work on this in fits and starts.

    Thanks Much!

    -Mike

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •