Excel - Delete rows containing string but keep header 1

[tourcd]

Hi,

I've got the following macro which runs through my spreadsheet looking for the word 'Heading' in column A. It deletes any row which contains the word 'Heading', great. However I would like it to keep the first occurance of 'Heading' and then continue to delete the rest. I'd then like it to loop through and do the same for 'Heading2' etc.

Can anyone point me in the right direction?

Public Sub FormatInput()
'
' FormatInput Macro
'
' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False

Dim T As Range
Dim SrchRng

Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))
Do
Set T = SrchRng.Find("Heading", LookIn:=xlValues)
If Not T Is Nothing Then T.EntireRow.Delete
Loop While Not T Is Nothing
'
' Turn screen updating back on.
Application.ScreenUpdating = True
End Sub

 

[xlbo]

Public Sub FormatInput()
'
' FormatInput Macro
'
' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False

    Dim T As Range
    Dim SrchRng
    
    Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))
    Do
        Set T = SrchRng.Find("Heading", LookIn:=xlValues, [b]lookat:=xlpart[/b])
        If Not T Is Nothing [b]and ucase(T.text) <> "HEADING" [/b]Then T.EntireRow.Delete
     Loop While Not T Is Nothing
'
' Turn screen updating back on.
Application.ScreenUpdating = True
End Sub

You should just be able to test the exact text in the cell - if it is EXACTLY "heading" then don;t delete

You should also specify using "xlpart" in the "lookat" statement as when the find methods runs, unless you specifiy the arguments to it, it will use whatever was run last so if you did a find using exact match only, then ran your original code, it would only find cells where the only text in ther was "heading"

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[tourcd]

Thanks for your input. Maybe I didn't explain what I'm after clearly, let me give you an example.

This is what I'm starting with...

Year Value1
2008 1
Year Value1
2008 2
Year Value1
2008 3
Year Value2
2008 1
Year Value2
2008 2
Year Value2
2008 3

I'd like to end up with...

Year Value1
2008 1
2008 2
2008 3
Year Value2
2008 1
2008 2
2008 3

 

[SkipVought]

Hi,

SORT the table.

If you want to do this progrmatically, you can use COUNTIF to determine the number of qualified rows to delete.

Skip,
[sup]Don't let the Diatribe...
talk you to death![/sup][sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SkipVought]

It might be better to use the AutoFilter to filter on the value, and the Delete Row method.

Skip,
[sup]Don't let the Diatribe...
talk you to death![/sup][sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[xlbo]

you said you're looking for the word "heading" and then mentioned "heading2" - so that's what I worked on

Are you now saying that you are actually looking for "2008"? in which case, why did your code state:

Find("Heading",


?????

Please be very specific about what is in your cells, what you want to delete and the criteria for doing so

If you want to search for "Year" and then delete and subsequent rows which match then I would suggest not using FIND as you will encounter difficulties when you delete rows:

Public Sub FormatInput()
Application.ScreenUpdating = False

    Dim lRow as long
    Const sRow = 1
    Const strHeader = "year"
    
    lRow ActiveSheet.Range("A65536").End(xlUp).row

    For i = lRow to sRow + 1 step -1

      if cells(i,1).value = strHeader then cells(i,1).entirerow.delete

    next i
Application.ScreenUpdating = True
End Sub

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[xlbo]

darnit!

lRow = ActiveSheet.Range("A65536").End(xlUp).row


Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[HarleyQuinn]

Geoff,

If I understand the OP correctly, what they want to do is find the first instance of "Heading", leave it then delete all other rows where the cell (AX I think, or BX if looking at the slightly confusing second example) contains "Heading". Then repeat this process for "Heading2", "Heading3" etc.

Is that what you're after tourcd?

HarleyQuinn
---------------------------------
The most overlooked advantage to owning a computer is that if they foul up there's no law against wacking them around a little. - Joe Martin

Get the most out of Tek-Tips, read FAQ222-2244 before posting.

 

[xlbo]

Hi Harley - yeh - that's what I thought and that's what my initial code would've done but then got into some error issues where the line with the found cell is deleted, so you can;t use FINDNEXT to get the next instance - therefore proposed code just looping from the bottom up to delete rows with a specified text (as per OPs 2nd example)

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[SkipVought]

Give this a try...

Sub test()
    Dim r As Range, sPrev As String, rFound As Range
    
    If Not ActiveSheet.AutoFilterMode Then ActiveSheet.[A1].AutoFilter
    
    ActiveSheet.[A1].AutoFilter Field:=2, Criteria1:="=Value*"
    
    Do
        Set rFound = Cells.Find("Value", Cells(Cells.SpecialCells(xlCellTypeVisible).Rows.Count, "A"))
        Set rFound = Cells.FindPrevious(rFound)
        
        If rFound.Row = 1 Then Exit Do
        
        If Application.CountIf(Range("B:B"), "=" & rFound.Value) > 1 Then
            rFound.EntireRow.Delete
        Else
            rFound.EntireRow.Hidden = True
        End If
    Loop
    ActiveSheet.ShowAllData
End Sub

Skip,
[sup]Don't let the Diatribe...
talk you to death![/sup][sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SkipVought]

Cleaned up a bit...

Sub test()
    Dim rFound As Range
    
    If Not ActiveSheet.AutoFilterMode Then ActiveSheet.[A1].AutoFilter
    
    ActiveSheet.[A1].AutoFilter Field:=2, Criteria1:="=Value*"
    
    Do
        Set rFound = Cells.Find("Value")
        
        With Cells.FindPrevious(rFound)
            If .Row = 1 Then Exit Do
            
            If Application.CountIf(Range("B:B"), "=" & .Value) > 1 Then
                .EntireRow.Delete
            Else
                .EntireRow.Hidden = True
            End If
        End With
    Loop
    
    ActiveSheet.ShowAllData
    
    Set rFound = Nothing
End Sub

Skip,
[sup]Don't let the Diatribe...
talk you to death![/sup][sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[tourcd]

Thanks SkipVought, your solution looks very tidy but I experience a problem when running it.

I get a "Run-time error '5': Invalid procedure call or argument" against this line...

Set rFound = Cells.FindPrevious(rFound)

Can you tell me why this is happening?

 

[tourcd]

SkipVought, I've found the problem, it was a typo on my part.

Thanks everyone for all your input, problem solved!