delete range of cells, given criteria

[emantzoo]

I want to use a macro to delete the range A:F in every row where the value in column E is equal to "del".

I came up with this, but it does not work:

For i = 1 To 35000
If Cells(i, 5) = "del" Then
    With Range(Cells(i, 1), Cells(i, 6)).Select
    
    Selection.Delete Shift:=xlUp
   
    End With
End If
Next i

So.. please help

 

[mumps]

Try this macro. When deleting rows you should start from the bottom and work up.

Sub DelRange()
    Application.ScreenUpdating = False
    Dim i As Long
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For i = LastRow To 1 Step -1
        If Cells(i, 5) = "del" Then
            Range(Cells(i, 1), Cells(i, 6)).Delete Shift:=xlUp
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[hiker95]

emantzoo,

If your worksheet does not have anything in it to the right of column F, then try the following.


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 DeleteRows()
' hiker9, 01/24/2014, ME752836
Dim r As Long
For r = 3500 To 1 Step -1
  If Cells(r, 5) = "del" Then Rows(r).Delete
Next r
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 DeleteRows macro.

 

[hiker95]

emantzoo,

Sample raw data:

Excel 2007
	A	B	C	D	E	F	G
1	A1	B1	C1	D1	E1	F1	G1
2	A2	B2	C2	D2	del	F2	G2
3	A3	B3	C3	D3	E3	F3	G3
4	A4	B4	C4	D4	del	F4	G4
5	A5	B5	C5	D5	E5	F5	G5
6	A6	B6	C6	D6	del	F6	G6
7	A7	B7	C7	D7	E7	F7	G7
8	A8	B8	C8	D8	del	F8	G8
9	A9	B9	C9	D9	E9	F9	G9
10	A10	B10	C10	D10	del	F10	G10
11	A11	B11	C11	D11	E11	F11	G11
12	A12	B12	C12	D12	del	F12	G12
13	A13	B13	C13	D13	E13	F13	G13
14	A14	B14	C14	D14	del	F14	G14
15	A15	B15	C15	D15	E15	F15	G15
16	A16	B16	C16	D16	del	F16	G16
17	A17	B17	C17	D17	E17	F17	G17
18	A18	B18	C18	D18	del	F18	G18
19	A19	B19	C19	D19	E19	F19	G19
20	A20	B20	C20	D20	del	F20	G20
21
Sheet1

After the new macro using two arrays in memory, and, no deleting any rows:

Excel 2007
	A	B	C	D	E	F	G
1	A1	B1	C1	D1	E1	F1	G1
2	A3	B3	C3	D3	E3	F3	G2
3	A5	B5	C5	D5	E5	F5	G3
4	A7	B7	C7	D7	E7	F7	G4
5	A9	B9	C9	D9	E9	F9	G5
6	A11	B11	C11	D11	E11	F11	G6
7	A13	B13	C13	D13	E13	F13	G7
8	A15	B15	C15	D15	E15	F15	G8
9	A17	B17	C17	D17	E17	F17	G9
10	A19	B19	C19	D19	E19	F19	G10
11							G11
12							G12
13							G13
14							G14
15							G15
16							G16
17							G17
18							G18
19							G19
20							G20
21
Sheet1

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 ReorgDataArrays()
' hiker9, 01/24/2014, ME752836
Dim a As Variant, o As Variant
Dim i As Long, ii As Long
Dim lr As Long, n As Long
lr = Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
a = Range("A1:F" & lr)
n = Application.CountIf(Columns(5), "del")
ReDim o(1 To UBound(a, 1) - n, 1 To UBound(a, 2))
For i = 1 To UBound(a, 1)
  If a(i, 5) <> "del" Then
    ii = ii + 1
    o(ii, 1) = a(i, 1): o(ii, 2) = a(i, 2): o(ii, 3) = a(i, 3)
    o(ii, 4) = a(i, 4): o(ii, 5) = a(i, 5): o(ii, 6) = a(i, 6)
  End If
Next i
Range("A1:F" & lr).ClearContents
Range("A1").Resize(UBound(o, 1), UBound(o, 2)) = o
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 ReorgDataArrays macro.