Delete certain accounts

C

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
 
B

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
 
C

chrisnsmith

Sorry Bob, it didn't work

Bob Phillips said:
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
 
C

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.
 
B

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
 
C

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
 
B

Bob Phillips

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

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top