Delete Rows, Except For Ones that Meet Certain Criteria(s)-CodePudding

I've made a For Each loop that'll keep data depending upon some criteria's, but I do not know how to format it so if a cell in column A contain exactly 8 numeric digits, then it'll keep the row.

Example:

Cell A289 Contains: 04245468 ← Keep this row

Cell A978 Contains: 04513 ← Delete this row

So far I have the following by using the left function within my code:

Sub CleanUpSheet1()

Dim RowA As Range
'hides any popups
Application.DisplayAlerts = False

'Deletes all blanks up to row 15,0000
Range("a2:A15000").Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

For Each RowA In Range("A2:A" & ActiveSheet.UsedRange.Rows.Count)
    If Left(RowA.Value, 5) <> "issue" And Right(RowA.Value, 4) <> "-000" And RowA.Value <> 0 Then
        RowA.EntireRow.Delete
    End If
Next
're-enables popups
Application.DisplayAlerts = True 
End Sub

CodePudding user response：

If it's just a matter of numbers you can transform the cell value into a string (RowA.Text or maybe Cstr(RowA.Value) and then test on the lenght :

if len(cstr(RowA.Value)) = 8 ??? (or len(RowA.Text))

Tell me if I havn't understood your question.

CodePudding user response：

Had to reformat this a lot.

Sub CleanUpSelect1()
Dim RowA As Range
Dim cRng As Range
Dim iCounter As Long

Set RowA = Sheet1.Range("A2:A" & Sheets("Sheet1").UsedRange.Rows.Count)
iCounter = 1
Do
    Set cRng = RowA(iCounter, 1) 'Loop rows
    If CStr(cRng.Value2) = vbNullString Then
        cRng.EntireRow.Delete
    Else
        If Not KeepRow(cRng.Value2) Then
            cRng.EntireRow.Delete  'Delete row
        Else
            iCounter = iCounter   1 'Advance
        End If
    End If
Loop While iCounter <= RowA.Rows.Count 'Stop after loop all rows
End Sub
Private Function KeepRow(RowValue As String) As Boolean
    KeepRow = (RowValue Like "########" Or RowValue Like "issue#" Or RowValue Like "######-###")
End Function

But it works.