Delete certain accounts

[chrisnsmith]

Joel supplied me with the following macro to clear accounts beginning with R.
Now I discover that I need to delete all accounts which contain an R.
Can someone help?

I am also attaching and example of my worksheet.

VB code:

Sub ClearAccounts()
Lastrow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
LastCol = Cells(6, Columns.Count).End(xlToRight).Column
RowCount = Lastrow
Do While RowCount >= 3
DeletedCells = False
For ColCount = 1 To LastCol Step 4
If Left(Cells(RowCount, ColCount), 1) = "R" Then
Set DeleteRange = Range(Cells(RowCount, ColCount), _
Cells(RowCount, ColCount + 2))
DeleteRange.Delete shift:=xlShiftUp
DeletedCells = True
End If
Next ColCount
If DeletedCells = False Then
RowCount = RowCount - 1
End If
Loop

End Sub

Example Worksheet:
A B C
1 HEADER ROW
2 "
3 "
4 "
5 "BLANK ROW"
6 Account L S
7 PF039 4
8 ROO43 1
9 PF045 1
10 QFF12 1
11 091 R0800 4
12 QG046 1
13 QG082 2
14 098 R0076 6
15 QI802 4
15 R1023 2

 

[Bob Phillips]

Sub ClearAccounts()
Lastrow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
LastCol = Cells(6, Columns.Count).End(xlToRight).Column
RowCount = Lastrow
Do While RowCount >= 3
DeletedCells = False
For ColCount = 1 To LastCol Step 4
If Left(Cells(RowCount, ColCount), 1) Like "*R*" Then
Set DeleteRange = Range(Cells(RowCount, ColCount), _
Cells(RowCount, ColCount + 2))
DeleteRange.Delete shift:=xlShiftUp
DeletedCells = True
End If
Next ColCount
If DeletedCells = False Then
RowCount = RowCount - 1
End If
Loop

End Sub

 

[chrisnsmith]

Sorry Bob, it didn't work

Sub ClearAccounts()
Lastrow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
LastCol = Cells(6, Columns.Count).End(xlToRight).Column
RowCount = Lastrow
Do While RowCount >= 3
DeletedCells = False
For ColCount = 1 To LastCol Step 4
If Left(Cells(RowCount, ColCount), 1) Like "*R*" Then
Set DeleteRange = Range(Cells(RowCount, ColCount), _
Cells(RowCount, ColCount + 2))
DeleteRange.Delete shift:=xlShiftUp
DeletedCells = True
End If
Next ColCount
If DeletedCells = False Then
RowCount = RowCount - 1
End If
Loop

End Sub

--
__________________________________
HTH

Bob

 

[Bob Phillips]

What did it do/not do as against what the previous version did?

 

[chrisnsmith]

For the 5 digit accounts that begin with R it worked fine, but some accounts
have 8 digits, such as 098 R4532, note the space before R, for these accounts
it did nothing.

 

[Bob Phillips]

Try this

Sub ClearAccounts()
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
LastCol = Cells(6, Columns.Count).End(xlToLeft).Column
RowCount = LastRow
Do While RowCount >= 3
DeletedCells = False
Debug.Assert RowCount <> 6
For ColCount = 1 To LastCol Step 4
If Cells(RowCount, ColCount).Value Like "*R*" Then
Set DeleteRange = Range(Cells(RowCount, ColCount), _
Cells(RowCount, ColCount + 2))
DeleteRange.Delete shift:=xlShiftUp
DeletedCells = True
End If
Next ColCount
If DeletedCells = False Then
RowCount = RowCount - 1
End If
Loop

End Sub

 

[chrisnsmith]

Tried it, but found I had to make a couple of changes to the following lines
of code to make it work.

Do While RowCount >= 3 ---->changes to 6 because of change in worksheet
DeletedCells = False
Debug.Assert RowCount <> 6 ----> Had to delete this line. Since I'm new
at this I
don't know what the line was suppose to do anyway.

At any rate it works great now. Thanks

 

[chrisnsmith]

Can you show me how to add a second criteria for the same range?

 

[Bob Phillips]

The Debug.Assert was some debug code that I added to test it with. Just
forgot to remove it.

 

[Bob Phillips]

I don't know what your criteria are, but just add an AND if you want both
conditions to be met, or an OR if only one needs to be met

Sub ClearAccounts()
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
LastCol = Cells(6, Columns.Count).End(xlToLeft).Column
RowCount = LastRow
Do While RowCount >= 6
DeletedCells = False For ColCount = 1 To LastCol Step 4
If Cells(RowCount, ColCount).Value Like "*R*" And _
Cells(RowCount, ColCount).Value Like "*X*" Then
Set DeleteRange = Range(Cells(RowCount, ColCount), _
Cells(RowCount, ColCount + 2))
DeleteRange.Delete shift:=xlShiftUp
DeletedCells = True
End If
Next ColCount
If DeletedCells = False Then
RowCount = RowCount - 1
End If
Loop

End Sub