Excel Macro to delete between 2 defined points

[bawpie]

Hi, I am looking to create a macro that can find data in a column then find
another specific entry in the same column and delete the data between the two
points. I have tried looking for other examples within the newsgroup but
most are to delete one specific row or to delete to the end of data etc and
therefore are not quite suitable.

Anyway, I have a worksheet. In Column A I might have:

A

Number 203
Service
Start Date
Closure
Reason for Closure
End
Number 205
Service
Start Date
Closure
Reason for Closure
End
Number 222
Service
Start Date
Closure
Reason for Closure
End

What I would like the macro to do is to locate 'Number 205' and delete each
row including Number 205 down to the first 'end' after 'Number 205.' The
rows between the 'Number' entry and the 'end' entry may sometimes vary so it
can't just locate the number and delete down a certain amount of rows.

Additionally, I would like the macro to work from a list located in another
sheet within the workbook, for example if I had a list like this in a sheet
called 'To Delete'
it would look like this:

A

Number 205
Number 222

So the macro needs to reference the list in the seperate sheet so it looks
for 205-end and deletes, then looks for 222-end and deletes and so on.

Hopefully there is a way of doing this, all advice and help is gratefully
received.

Thanks

 

[Jacob Skaria]

Try the below and feedback. Create a named range called 'deletelist'..


Sub Macro()

Dim lngRow As Long, lngLastRow As Long
Dim lngTemp As Long, blnFound As Boolean

lngLastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
For lngRow = 1 To lngLastRow
If blnFound = False Then
If WorksheetFunction.CountIf(Range("Deletelist"), Range("A" & lngRow)) > 0
Then
blnFound = True: lngTemp = lngRow
End If
Else
If Trim(Range("A" & lngRow)) = "End" Then
Range("A" & lngTemp & ":A" & lngRow).ClearContents
blnFound = False
End If
End If
Next

End Sub

If this post helps click Yes

 

[Sheeloo]

Another macro...
(it assumes that end will be found after the first match)
Change the value of firstValue variable...
You can read in the value in the variable firstValue from a cell on another
sheet and loop through all the values there...

Macro:

Sub findDelete()
firstvalue = "Number 205"
SecondValue = "End"
With Worksheets(1).Range("a:a")
Set c = .Find(firstvalue, LookIn:=xlValues)
If Not c Is Nothing Then
firstRow = c.Row
Set c = .Find(SecondValue, LookIn:=xlValues)
secondRow = c.Row
Do
Set c = .FindNext(c)
secondRow = c.Row
Loop While secondRow < firstRow
Worksheets(1).Range("A" & firstRow & ":A" & secondRow).EntireRow.Delete
Else
MsgBox firstvalue & " ... Not FOUND!"
End If
End With
End Sub

 

[Joel]

I would key on the word "number" and "end" like the code below. I started at
the last row and moved up the worksheet because it is easier to delete rows
using this method.


Sub RemoveData()

LastRow = Range("A" & Rows.Count).End(xlUp).Row
RowCount = LastRow
With Sheets("Sheet2")
Do While RowCount >= 1
Data = .Range("A" & RowCount)
If Data = "End" Then
Endrow = RowCount
Else
If Left(Data, 6) = "Number" Then
'get the number from the string
Number = Val(Trim(Mid(Data, InStr(Data, " "))))
If Number <= 205 Then
.Rows(RowCount & ":" & Endrow).Delete
End If
End If
End If
RowCount = RowCount - 1
Loop
End With
End Sub

 

[bawpie]

Thanks Jacob, this looks like it should do the job - I've had to alter it
slightly (one line was missing the 'Then' - it was on the line below) - it
seems to be deleting the correct entries but it's also deleting the first 65
rows of data (none of which should be deleted? - I tried putting an 'end' at
the top of the data but that didn't stop it) - also, would it be possible to
delete rows rather than just clear contents - I know I can just filter on
blank cells and delete that way which is fine.

Thanks for your help, and also for the other response (which I haven't had a
chance to look at yet!)

 

[Jacob Skaria]

I hope you dont have blank rows in between your data and the 'deletelist' (as
your original example) which might be causing the deletion. I have modified
to handle blanks and to delete the rows....Try and feedback. Make sure the
deletelist is in another worksheet; so that it does not get deleted...

Sub Macro()

Dim lngRow As Long, lngLastRow As Long
Dim lngTemp As Long, blnFound As Boolean

lngLastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
For lngRow = lngLastRow To 1 Step -1
If Trim(UCase(Range("A" & lngRow))) = "END" Then
lngTemp = lngRow: blnFound = True
End If

If blnFound = True Then
If Trim(Range("A" & lngRow)) <> "" And _
WorksheetFunction.CountIf(Range("Deletelist"), Range("A" & lngRow)) > 0 Then
Rows(lngRow & ":" & lngTemp).Delete: blnFound = False
End If
End If

Next

End Sub


If this post helps click Yes