VBA - Delete cells with a specific value

[shebe228]

I have some sample data below and I want to write a code that will delete anything in a specific range of columns if it has a specific parameter in the AC column.


For example, if "REMOVE" is in AC2 and AC3, I want to delete cells V2:AC3 and shift the remaining data up. The amount of rows will vary, but the "REMOVE" tag will always be at the most top rows of the spreadsheet. This particular report spans 52 tabs at this time so I will loop through all worksheets.

S

T

U

V

W

X

Y

Z

AA

AB

AC

AD

AE

AF

AG

AH

1

x

x

x

State

TIN

BC

Allwd

Cntr

Dbblr

Activity

Bad TINS

x

x

x

x

x

2

MS

5546868

23

400

Matt

Declined

6/1/18

REMOVE

3

TN

4654654

58

4654

James

Successful

8/2/18

REMOVE

4

CA

8978793

100

873

Bob

Successful

7/15/18

5

FL

7352421

586

7352

Emily

None

8/7/18

6

TN

5646451

987

3215

Sue

Initial

2/8/17

<tbody>
</tbody>

 

[Coding4Fun]

Sub Test()


'Loop through each Sheet and check AC for "REMOVE"
For i = 1 To Sheets.Count
Sheets(i).Activate


'Set the range to check - based on last row in column W
myRange = Cells(Rows.Count, 23).End(xlUp).Row


'Loop through the sheet and look for rows to delete
For x = 2 To myRange
    If Range("AC" & x).Value = "REMOVE" Then
        ' Note this is deleting and shifting up Rows A-V and AC onward remain unchanged
        Range("V" & x & ":AC" & x).Delete xlShiftUp
        x = x - 1
    End If
Next x


Next i


End Sub

 

[Michael M]

Are you sure you only want to remove a certain range and not the entire row ??
Deleting ranges can really mess up data if you get it wrong !!
This will remove the entire row if "'REMOVE" is in col AC of each sheet

Sub MM1()
dim ws as worksheet
For ws = 1 To Sheets.Count
Sheets(ws).Activate
    With Columns("AC")
        .AutoFilter field:=1, Criteria1:="REMOVE"
        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilter
    End With
Next ws
End Sub

 

[shebe228]

Are you sure you only want to remove a certain range and not the entire row ??
Deleting ranges can really mess up data if you get it wrong !!



I definitely just want to delete the range. Each sheet has multiple "tables" (not actual excel tables) that feed into two other workbooks with 8 pivot tables referencing each tab. This worksheet has about 50 tabs for each client so it's a lot going on. ? Its something I've built over the last year and a half making tweaks as I go so its definitely not the most efficient strategy, but I dont have the time (or will!!) to start over.

I pull the client reports separate and run macros on them before dumping them into the giant workbook. So it wouldn't be the end of the world if something messed up because it's fairly easy to recreate (and have learned the hard way to save in multiple places after each step!). Thanks for your help!!

 

[Peter_SSs]

Not sure whether column AC might contain formulas that result in REMOVE or "", but just in case this has a built-in mechanism in case that is the case. Otherwise with the (xlUp) approach more rows than expected could get removed.
Test in a copy of your workbook

Sub Delete_Ranges()
  Dim ws As Worksheet
  Dim RemCount As Long
  
  For Each ws In Worksheets
    RemCount = WorksheetFunction.CountIf(Intersect(ws.UsedRange, ws.Columns("AC")), "REMOVE")
    If RemCount > 0 Then ws.Range("V2:AC" & RemCount + 1).Delete Shift:=xlUp
  Next ws
End Sub

 

[shebe228]

not sure whether column ac might contain formulas that result in remove or "", but just in case this has a built-in mechanism in case that is the case. Otherwise with the (xlup) approach more rows than expected could get removed.
Test in a copy of your workbook

sub delete_ranges()
  dim ws as worksheet
  dim remcount as long
  
  for each ws in worksheets
    remcount = worksheetfunction.countif(intersect(ws.usedrange, ws.columns("ac")), "remove")
    if remcount > 0 then ws.range("v2:ac" & remcount + 1).delete shift:=xlup
  next ws
end sub

this works perfectly!!!!!!!! thank you!!!!!!!!!!!!!!!!!!!!!!!!!!

 

[Peter_SSs]

this works perfectly!!!!!!!! thank you!!!!!!!!!!!!!!!!!!!!!!!!!!

You are very welcome.