Selecting Rows Based on a single cell value

[thunder_anger]

Hi guys

i searched a lot but couldn't reach any thing

i have a program that generate Html Reports and then convert to excel the thing is that after different data the programs puts a row that have a cell containing "=" equal sign followed by 7 rows of unneeded data but the problem that i have that the report is more than 30000 rows
is there any macro to search for the row that contains "=" in column "D" and then select that row in addition to those 7 rows and delete them ??

Help is appreciated??

 

[mirabeau]

hi,

copy your data onto a new worksheet (for testing) and see if this macro does what you want

Sub valuecolD()
Dim lr&, lc&, a As Range, e, k&
lr = Range("D" & Rows.Count).End(xlUp).Row
lc = Cells.SpecialCells(11).Column
Set a = Range("D1").Resize(lr)
For Each e In a
If InStr(e, "=") > 0 Then
    k = k + 1
    e.Offset(, lc).Resize(8) = 1
End If
Next e
Range("A1", Cells(lr, lc + 1)).Sort Cells(1, lc + 1), 1, Header:=xlNo
If k > 0 Then Range("A1", Cells(k + 8, lc + 1)).Delete xlUp
End Sub

 

[Misca]

This should be quite fast if there's many ='s to be found: in your data

Sub DeleteEquals()

'Uses the Kickbutt VBA Find Function found from Ozgrid.com

Dim Matches As Range
Dim c As Range
Dim DelRange As Range

Set Matches = Find_Range("=", Columns("D"), MatchCase:=True)

If Not Matches Is Nothing Then
    For Each c In Matches
        If Not DelRange Is Nothing Then
            Set DelRange = Union(DelRange, c.Resize(8))
        Else
            Set DelRange = c.Resize(8)
        End If
    Next c
End If

If Not DelRange Is Nothing Then
    DelRange.EntireRow.Delete shift:=xlUp
End If

End Sub


Function Find_Range(Find_Item As Variant, _
    Search_Range As Range, _
    Optional LookIn As Variant, _
    Optional LookAt As Variant, _
    Optional MatchCase As Boolean) As Range
     
    Dim c As Range
    If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas
    If IsMissing(LookAt) Then LookAt = xlPart 'xlWhole
    If IsMissing(MatchCase) Then MatchCase = False
     
    With Search_Range
        Set c = .Find( _
        What:=Find_Item, _
        LookIn:=LookIn, _
        LookAt:=LookAt, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=MatchCase, _
        SearchFormat:=False)
        If Not c Is Nothing Then
            Set Find_Range = c
            firstAddress = c.Address
            Do
                Set Find_Range = Union(Find_Range, c)
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
     
End Function

The Kickbutt VBA Find Function was found from www.ozgrid.com/forum/showthread.php?t=27240&page=1

 

[mirabeau]

thunder_anger

I checked my above code and it should be modified.

Could you please replace it with this, which seems to do what you want, and should be OK fast

Sub colDdel()
Dim lr&, lc&, a As Range, e, k&
lr = Range("D" & Rows.Count).End(xlUp).Row
lc = Cells.Find("*", after:=Cells(1, 1), searchorder:=xlByColumns, _
    searchdirection:=xlPrevious).Column
Set a = Range("D1").Resize(lr)
For Each e In a
If InStr(e, "=") > 0 Then
    k = k + 1
    e.Offset(, lc - 3).Resize(8) = 1
End If
Next e
Range("A1", Cells(lr + 7, lc + 1)).Sort Cells(1, lc + 1), 1, Header:=xlNo
If k > 1 Then Range("A1", Cells(Rows.Count, lc + 1).End(3)).Delete xlUp
End Sub

 

[thunder_anger]

thanks guys
My internet connection is not stable
i will test them for now

 

[thunder_anger]

thunder_anger

I checked my above code and it should be modified.

Could you please replace it with this, which seems to do what you want, and should be OK fast

that worked perfect
thanks again

Magic