CODEWITHSUNDEEP
excelvba
Djhans26
Djhans26

Reputation: 79

My code won’t delete lines of unnecessary data under the data I’m trying to keep

Sub DeleteExtraValues ()

    Dim I as Integer, strValueToFind As String, lngRows As           Long, she As Worksheet
     Set an = ThisWorkbook.ActiveSheet
     LngRows = sh.Range(“A1048576”).End(xlUp).Row
     strValueToFind = “DCAP”
     For I = 1 To lngRows
        If InStr(Cells(I,1).Value, strValueToFind) = 0 Then
           If Cells(I,1).Value = “” Then
           Else
               Rows(I).Delete
                I = I-1
           End If
      End If
    Next I
End Sub

When running this, it will delete the cells above the data I want to keep and then will stop once it gets to the first cell that contains “DCAP”. I need it also to delete any unnecessary information after the last cell that contains “DCAP”.

Upvotes: 0

Views: 102

Answers (2)

GMalc
GMalc

Reputation: 2628

Try this...

    Dim rng As Range
    Set rng = ActiveSheet.Range("A1").CurrentRegion 'depending on your data you may have to change to a specific range using last row and column

' change the `Field` to the column that contains "DCAP"   
    With rng 
        .AutoFilter Field:=9, Criteria1:="<>DCAP", Operator:=xlAnd 'select all cells that are not "DCAP"
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete 'don't delete the header row
        .AutoFilterMode = False
    End With

Upvotes: 0

Shaves
Shaves

Reputation: 930

Try this code. It removes every row that doesn't contain DCAP in the first column.

Dim r As Long
Dim LastRow As Long

r = 1
LastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row

Do Until r > LastRow
   DoEvents
   If InStr(1, Cells(r, 1), "DCAP") > 0 Then
        r = r + 1
   Else 
        Cells(r, 1).EntireRow.Delete
        LastRow = LastRow - 1
   End If

Loop

MsgBox

"done"

Upvotes: 1

Related Questions