Deleting rows based on a certain columns 'prefixes'?

For one of my columns within an excel spreadsheet, I have department numbers that consist of five digits.
I am hitting a roadblock in writing a macro that will delete any row containing department numbers that begin with a certain combination of 2 numbers.

Example:

Dept: \ Hours:
10301 \ 134.11
10303 \ 45.10
10310 \ 169.05
10311 \ 37.69
11332 \ 4.50
11363 \ 433.12

Would need to delete rows containing those starting with an 11 underneath the department column, without effecting other departments or the hours column



In addition, is there any type of macro that, after deleting those numbers starting with 11, would also delete all of the other 'prefixes' (so delete the first two numbers on all of the departments?)

Thank you so much.


(Sorry, I cannot provide a sample workbook, due to using this for sensitive timesheet information within my company)

Mgassma,

Welcome to the Excel Forum.

You have not given us enough information.

1. What is the worksheet name?

2. What column contains the title Dept:?

3. What cell is the title Dept: in?

4. What is the first row that contains raw data?


I have a macro ready to go, but, I will need the answers to the above 4 questions.

Try this on a back up copy and see if it meets your needs. Reference to Sheet1 is to the sheet code name - change it as needed.
This assumes values in first column (A) are always 5-digits.

Option Explicit

Sub DeleteRows()

    Dim vNum As Variant, vUpper As Long
    Dim lastrow As Long
    Dim C As Range
    
    vNum = Application.InputBox("Enter the two-number combination", Type:=2)
    
    If Len(vNum) > 2 Then
        MsgBox ("More than two digits were entered"), vbExclamation
        Exit Sub
    End If
    
    vNum = CLng(vNum) * 1000
    vUpper = vNum + 1 * 1000
    
    Application.ScreenUpdating = False
    
    With Sheet1
        lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
        .AutoFilterMode = False
        .Range("A1:B" & lastrow).AutoFilter Field:=1, Criteria1:=">=" & vNum, Operator:=xlAnd, Criteria2:="<" & vUpper
        .Range("A1:B" & lastrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilterMode = False
        lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
        For Each C In .Range("A2:A" & lastrow)
            C.Value = Mid(C.Value, 3, Len(C) - 2)
        Next C
    End With
    
    Application.ScreenUpdating = True

End Sub

Palmetto -

Thank you, but is there a way I can do it without having to enter the code every time? I will always be deleting those that don't start with a 10.

Here is the code revised, no input box, delete all rows that don't start with "10" and strips first two digits from department.

Option Explicit

Sub DeleteRows2()

    Dim lastrow As Long
    Dim c As Range
    
    Application.ScreenUpdating = False
    
    With Sheet1
        lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
        .AutoFilterMode = False
        .Range("A1:B" & lastrow).AutoFilter field:=1, Criteria1:=">10999"
        .Range("A1:B" & lastrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilterMode = False
        lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
        For Each c In .Range("A2:A" & lastrow)
            c.Value = Mid(c.Value, 3, Len(c) - 2)
        Next c
    End With
    
    Application.ScreenUpdating = True
    
    End Sub

Mgassma,

If you had given us all the information we needed from the beginning, your request would have been solved the first time around.

Thanks for the information.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub DeleteRowsAndPrefixes()
' stanleydgromjr, 07/01/2013
' http://www.excelforum.com/excel-programming-vba-macros/935629-deleting-rows-based-on-a-certain-columns-prefixes.html
Dim r As Long, lr As Long
Application.ScreenUpdating = False
With Sheets("Timecard")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  For r = lr To 2 Step -1
    If Left(.Cells(r, 1), 2) = 11 Then
      .Rows(r).Delete
    Else
      .Cells(r, 1) = Right(.Cells(r, 1), 3)
    End If
  Next r
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the DeleteRowsAndPrefixes macro.