Using Macros to delete cells & rows based on specific criteria

[schnellsls]

Hello,

Each week I run a report that produces over 2,000 rows. I have to manually go through and delete things, by the time I am done, there may only be 320 rows left. I would apply a recorded macro, but the report is not consistent each week. There may be more or fewer rows depending on the week.

I would like to be able to run a macro that looks in column B for a specific value and if it contains that specific value, I would like the cells to the right of it to have their contents cleared.

Next, in column C, I have...

Employee2's Name
Employee2's Number
SPACE
Employee3's Name
Employee3's Number
SPACE
SUB TOTAL
SPACE
SPACE
SUB TOTAL
SPACE
(and this repeats over and over... the number of employees may be more or less)

I would like to be able to delete the rows, starting from Employee 2 to just before the second SUB TOTAL.

So, all I would have left in column C is

SUB TOTAL
SPACE

Please let me know if you require any more specific information.

Thank you very much for your help.

 

[schnellsls]

Hello,

I tried using the code you sent over for the data that I supplied and it worked wonderfully. Thank you!

However, when I tried it for my data set I was still getting those run time errors.

I am copying an exact copy of my data. Names and numbers have been masked but everything else is in its right place.

I am not sure what needs to be changed from the code you sent over though.

Thank you very much for your help!

Excel Workbook
	A	B	C	D	E	F	G	H	I
1	DATE: 05-07-2012		Co. Name						PAGE:1
2	TIME: 10:18:06		CLIENT TAX BILLING REPORT
3
4						OVER LIMIT
5	COMPANY NAME	TAX DESCRIPTION	EMPLOYEE NAME	GROSS TXBL SHLTRD WAGES		WAGES	BILLED	EMPLOYER	EMPLOYER
6	COMPANY ID	TAX CODE	EMPLOYEE ID	GROSS TAX	SHLTRD TAX	TAX	AMOUNT	NET TAXABLE	TAX ACCRUED
7
8	Client Company Name	NV SUTA	EE1	123	0	0	123	123	123
9	355	29-24	J006783275	123	0	0
10
11			EE2	123	0	0	123	123	123
12			F03256799	123	0	0
13
14			SUB-TOTALS:	123	0	0	123	123	123
15				123	0	0
16
17			SUB-TOTALS:	123	0	0	123	123	123
18				123	0	0
19
20	Client Company Name	NV SUTA	EE1	123	0	0	123	123	123
21	1778	29-24	E0685070	123	0	0
22
23			EE2	123	0	0	123	123	123
24			P0563456	123	0	0
25
26			EE3	123	0	0	123	123	123
27			Y04345968	123	0	0
28
29			EE4	123	0	0	123	123	123
30			V0323413	123	0	0
31
32			EE5	123	0	0	123	123	123
33			A0489458	123	0	0
34
35			EE5	123	0	0	123	123	123
36			J05345579	123	0	0
37
38			SUB-TOTALS:	123	0	0	123	123	123
39				123	0	0
40
41			SUB-TOTALS:	123	0	0	123	123	123
42				123	0	0
Sheet1

 

[circledchicken]

Still works for me. Perhaps check the following:

• Are the blank cells in column A truly empty or do they have perhaps a blank result of a formula in them?
• Are you running the code when a different sheet is selected? If so perhaps try this instead:

Sub example()

Dim ar As Range

With Sheets("Sheet1")
    For Each ar In .Range("A8:A" & .Range("D" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Areas
        ar.Resize(ar.Rows.Count - 2, 1).EntireRow.Delete
    Next ar
End With

End Sub

 

[schnellsls]

Hello,

The code still comes back with the same error. Not sure why. I am using Excel 2010. I have tried using it on a CSV file and a xlsx file.

The sheet that I am using is selected.
Also, the data I am trying to do this to has about 3000 rows. Might that have something to do with it?

Thank you again for your help!

 

[schnellsls]

Hello,

I did a bit more testing with the data. I tried many different things, but ultimately I saw you were using SpecialCells(xlCellTypeBlanks). Which means, if for some reason my cells are not truly blank, there would be an issue, (as you had suggested before). Even after pressing CTRL + ~ to see what was in the cells, it still looked like they were blank. It wasn't until after I took the supposedly blank cells from Columns A and B, and cleared their contents, that the code worked.

Now I am curious, how do I automatically make blank cells truly blank, in order to actually use the SpecialCells(xlCellTypeBlanks)?

Thank you,

 

[circledchicken]

Hello,

I did a bit more testing with the data. I tried many different things, but ultimately I saw you were using SpecialCells(xlCellTypeBlanks). Which means, if for some reason my cells are not truly blank, there would be an issue, (as you had suggested before). Even after pressing CTRL + ~ to see what was in the cells, it still looked like they were blank. It wasn't until after I took the supposedly blank cells from Columns A and B, and cleared their contents, that the code worked.

Now I am curious, how do I automatically make blank cells truly blank, in order to actually use the SpecialCells(xlCellTypeBlanks)?

Thank you,

It seems like you don't have any formulae in the range (and I don't think it would be a good idea anyway to make formula cells that return a blank 'truly blank').

For the others I think you would do what you mentioned - clear the contents (e.g. that would get rid of spaces in cells for example).

But the best thing would be to find out why they are not blank in the first place and fix that.

Perhaps post your workbook (anonymised) e.g. on SkyDrive, or Box.com and I or someone else can have a look - there might be a better way of doing it than using the SpecialCells method.

 

[schnellsls]

Hello,

I have been playing around with different bits of VBA throughout the day, and I found this


Sub TestIt()
Range("A1").Replace "", "blank"

End Sub


This actually takes those cells that look blank, but really aren't and adds "blank" to them. Would there be a way to re-write the code you initially gave me to use a form of = " " instead of special cells xl cell type blanks ?

This is what you sent me...
=======================================

Sub example2()

Dim ar As Range

With Sheets("Sheet1")
For Each ar In .Range("A8:A" & .Range("D" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Areas
ar.Resize(ar.Rows.Count - 2, 1).EntireRow.Delete
Next ar
End With

End Sub


======================================
How would the proper syntax be for this...
instead of calling the cells blank, could we reference them as equal to "" ?
======================================


Sub example2()

Dim ar As Range

With Sheets("Sheet1")
For Each ar In .Range("A8:A" & .Range("D" & .Rows.Count).End(xlUp).Row).= "".Areas
ar.Resize(ar.Rows.Count - 2, 1).EntireRow.Delete
Next ar
End With

End Sub

===========================================

Thank you,

 

[schnellsls]

Hello,

I have placed the macro enabled excel file on box.com, please use this link to view / download the spreadsheet.

https://www.box.com/s/e92b63083e862f901722

The first sheet is the original set of data.
The second sheet has had 2 macros applied to it.
The third macro does not quite work for the data set because the supposedly empty cells are not truly blank.

Here are the Macros I am working with...




Sub SUTA_Format()
'
' SUTA_Format Macro
' SUTA Format Resizes cells, changes colors making it easier to read
'

'
Rows("7:7").Select
Selection.ClearContents
Columns("A:I").Select
Columns("A:I").EntireColumn.AutoFit
Columns("B:B").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""NV SUTA"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16752384
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13561798
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Columns("C:C").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""SUB-TOTALS:"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16752384
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13561798
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub


Sub DeleteCELLS()
'This function deletes the cells C:I adjacent to NV SUTA and 29-24

Dim vArr As Variant
Dim iLoop As Long
Dim rNa As Range
Dim i As Long, j As Long

vArr = Array("NV SUTA", "29-24")
For j = 0 To UBound(vArr)
iLoop = WorksheetFunction.CountIf(Columns(2), vArr(j))
Set rNa = Range("B1")
For i = 1 To iLoop
Set rNa = Columns(2).Find(What:=vArr(j), After:=rNa, _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True)
rNa.Offset(0, 1).Resize(1, 7).Clear
Next i
Next j

End Sub

Sub DeleteRows()

'This function should delete the rows...

Dim ar As Range

With Sheets("Sheet1")
For Each ar In .Range("A8:A" & .Range("D" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Areas
ar.Resize(ar.Rows.Count - 2, 1).EntireRow.Delete
Next ar
End With

End Sub




Thank you,

 

[circledchicken]

Hello,

I had a look at your file - you had some cells in column A with a single space in them, so they looked empty but weren't really empty.

Here is some slightly revised code to deal with that. I also 'cleaned up' your first macro a little - you don't need to select ranges to work with them and using the With statement you can remove unnecessary repetition. Try these on the file you posted to Box.com:

Option Explicit

Sub SUTA_Format()
'
' SUTA_Format Macro
' SUTA Format Resizes cells, changes colors making it easier to read
'
Dim i As Long
Dim vArr() As Variant
    
Rows("7:7").ClearContents
Columns("A:I").EntireColumn.AutoFit

vArr = Array("NV SUTA", "B:B", "SUB-TOTALS:", "C:C")
For i = 0 To UBound(vArr) Step 2
    With Columns(vArr(i + 1))
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
            Formula1:="=""" & vArr(i) & """"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1)
            .Font.Color = -16752384
            .Font.TintAndShade = 0
            .Interior.PatternColorIndex = xlAutomatic
            .Interior.Color = 13561798
            .Interior.TintAndShade = 0
            .StopIfTrue = False
        End With
    End With
Next i

End Sub

Sub DeleteCELLS()
'This function clears the cells C:I adjacent to NV SUTA and 29-24

Dim vArr As Variant
Dim iLoop As Long
Dim rNa As Range
Dim i As Long, j As Long

vArr = Array("NV SUTA", "29-24")
For j = 0 To UBound(vArr)
    iLoop = WorksheetFunction.CountIf(Columns(2), vArr(j))
    Set rNa = Range("B1")
    For i = 1 To iLoop
        Set rNa = Columns(2).Find(What:=vArr(j), After:=rNa, _
            LookIn:=xlValues, LookAt:=xlWhole, _
            SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=True)
        rNa.Offset(0, 1).Resize(1, 7).Clear
    Next i
Next j

End Sub

Sub DeleteRows()

'Delete rows for each company except the last subtotal

Dim ar As Range

With Sheets("[COLOR="DarkRed"][B]Original[/B][/COLOR]")
    With .Range("A8:A" & .Range("D" & .Rows.Count).End(xlUp).Row + 1)
        ' remove any cells with single spaces in them - this allows the SpecialCells
        ' method that follows to select the correct range
        .Replace What:=" ", Replacement:="", LookAt:=xlWhole, SearchOrder:=xlByRows, _
            MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        ' add a border to the last+1 row so that the usedrange is expanded
        ' to allow consistent resize in the next step
        .Cells(.Rows.Count, 1).Resize(1, 9).Borders.LineStyle = xlContinuous
        ' keep only the last Subtotal for each Company
        For Each ar In .SpecialCells(xlCellTypeBlanks).Areas
            ar.Resize(ar.Rows.Count - 3, 1).EntireRow.Delete
        Next ar
    End With
End With

End Sub

Also note you need to change the part in red above to your actual sheet name when you do it with your actual data.

 

[schnellsls]

Thank you circledchicken!
It works beautifully!

That was it. I guess there must have been a space created by the other software program in those cells. Thank you for helping me figure this out!

Thank you!

 

[circledchicken]

Thank you circledchicken!
It works beautifully!

That was it. I guess there must have been a space created by the other software program in those cells. Thank you for helping me figure this out!

Thank you!

Your welcome - I'm glad it worked.