Macros in Excel

[Klartigue]

I am trying to write a macro in excel. Column A is made up of either the words Block or Allocation in each row. I want to create a macro to deletes the rows that say allocation. How do I do that?

Example:

Column A:

Block
Allocation
Block
Block
Allocation
Allocation
Allocation

How do i delte the allocation rows?

[Bob Phillips]

Public Sub ProcessData()
Dim Lastrow As Long
Dim i As Long

Application.ScreenUpdating = False

With ActiveSheet

Lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = Lastrow To 1 Step -1

If Cells(i, "A").Value2 = "Allocation" Then

.Rows(i).Delete
End If
Next i
End With

Application.ScreenUpdating = True
End Sub

[Kenneth Hobs]

The approach given by xld is the typical bottom up row delete method. This method is easy to understand and prevents some formula errors seen when deleting rows from the top down.

I decided to write a routine to use a Find function to make this sort of thing a bit more routine. This may seem complicated but it should not be all that bad. Whatever you do, test routines like this that delete rows, on a backup copy of your file.

Comment out the line of code that deletes the rows in the Test routine and uncomment the MsgBox line. You can then see what ranges that it founds. Hopefully, Excel will delete the found range areas in the order shown in the MsgBox. If not, we can delete areas in a loop as commented.

Another method used by some is the filter method.

I attached a file that includes my Speed routines as posted in the kb to make this easier to play with. It also contains xld's solution.
Sub Test_FoundRanges()
Dim findRange As Range, findString As String, foundRange As Range
Dim r As Range, i As Long

On Error GoTo EndNow:
'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn

Set findRange = ActiveSheet.Range("A1:A" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row)
findString = "Allocation"
Set foundRange = FoundRanges(findRange, findString)
If foundRange Is Nothing Then GoTo EndNow

'If Not foundRange Is Nothing Then MsgBox foundRange.Address 'Note that range is in reverse order
If Not foundRange Is Nothing Then foundRange.EntireRow.Delete
'For i = i to foundRange.Areas.Count
' foundRange.Areas(i).EntireRow.Delete
'Next i

EndNow:
SpeedOff
End Sub


Function FoundRanges(fRange As Range, fStr As String) As Range
Dim objFind As Range
Dim rFound As Range, FirstAddress As String

With fRange
Set objFind = .Find(what:=fStr, After:=fRange.Cells(fRange.Rows.Count, fRange.Columns.Count), _
LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=True)
If Not objFind Is Nothing Then
Set rFound = objFind
FirstAddress = objFind.Address
Do
Set objFind = .FindNext(objFind)
If Not objFind Is Nothing Then Set rFound = Union(objFind, rFound)
Loop While Not objFind Is Nothing And objFind.Address <> FirstAddress
End If
End With
Set FoundRanges = rFound
End Function