Locate & save rows with specific format and delete the r

[rrmando]

Hello party people. Always a pleasure to be here learning from all of you. I need some guidance/help filtering rows from a report. It contains @ 5000 rows of data.

Based on column A, we need to find and keep the rows that contain an 8 digit job number and a job name. Here is a small sample (6 rows) of the way our data currently downloads (under column A):

   3155       L A Branch O/H 21-01      
   3155       L A Branch O/H 21-01      
   3156       KP  21-03  
        31561140 KP      
        31561141 KP      
        31561142 KP

The rows we are interested in look like the bottom 3 rows. There are spaces before the data (exactly 8 spaces before the data in the cells we are interested in) and in between the data. I can insert a new column and use =SUBSTITUTE() to get rid of all spacing if necessary, but maybe it's not necessary, then proceed with filtering what we need and manually deleting the other rows. Of course it would be nice to automate.

The data begins on row 13 and the bottom will vary on the amount of data for that month. We want to keep the rows that meet the criteria and delete the rest of the rows. There exist empty single rows throughout the report (empty row then subtotal row then data continues). Only at the end of the data do you find more than one empty row. Any help will be greatly appreciated. Thank you.

 

[Barrie Davidson]

Couple of questions:

1. Does your data have a header row?

2. Is it fair to say that you want to delete ALL rows where the cell in column A does not begin with eight leading spaces?

 

[rrmando]

Thanks for the reply Barrie.

1. Yes, my data has a header row, or header info, from rows 1 through 12. That is consistent based on how the data is extracted from our system into Excel.

2. Yes, it is fair to say that I need ALL rows where the cell in column A does not begin with 8 leading spaces.

The suspense is killing me man!

 

[Barrie Davidson]

Have a try at this code:

Sub DeleteRows()
'Written by Barrie Davidson

Dim FilterRange As Range
Dim DeleteRange As Range

Application.ScreenUpdating = False
Columns("B:B").Insert Shift:=xlToRight
Set FilterRange = Range("A12:B" & Range("A65536").End(xlUp).Row)
Set DeleteRange = FilterRange.Offset(1).Resize(FilterRange.Rows.Count - 1)
DeleteRange.Offset(, 1).Resize(, 1).FormulaR1C1 = "=LEFT(RC[-1],8)=""        """
FilterRange.AutoFilter Field:=2, Criteria1:="=FALSE", Operator:=xlAnd
On Error Resume Next
DeleteRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete
FilterRange.AutoFilter
Columns("B:B").Delete
Application.ScreenUpdating = True
End Sub

Hope this does the trick!

 

[rrmando]

You da man Barrie! It runs extremely fast too. Here I was trying to put pieces of code together for a mickey mouse macro. No way I would have figured it out. You have made the process a lot more efficient. I truly appreciate it. Thank you.