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
--
__________________________________
HTH
Bob
"chrisnsmith" wrote in message
...
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" wrote:
What did it do/not do as against what the previous version did?
--
__________________________________
HTH
Bob
"chrisnsmith" wrote in message
...
Sorry Bob, it didn't work
"Bob Phillips" wrote:
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
"chrisnsmith" wrote in message
...
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