Vba help

[Donai]

Hi, the below code deletes everything that does not start with "W", how can i add another case where i need data that starts with "SMP", so delete everything that does not start with "W" and "SMP"

Public Sub ClearColB2()
Dim i   As Long, _
    LR  As Long

Dim ShtRec As Excel.Worksheet

Set ShtRec = Sheets(gstrRec)

LR = ShtRec.Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = LR To 6 Step -1
    Select Case Left(ShtRec.Range("B" & i).Value, 1)
        Case "W"
        Case Else
            ShtRec.Rows(i).Delete
    End Select
    
Next i

End Sub

 

[Donai]

*bump*

 

[Yard]

Sorry, posted an incorrect solution...

 

[Yard]

Try

Public Sub ClearColB2()
Dim i As Long, LR As Long, s As String
Dim ShtRec As Excel.Worksheet

Set ShtRec = Sheets(gstrRec)

LR = ShtRec.Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = LR To 6 Step -1
    s = CStr(ShtRec.Range("B" & i).Value)
    If s Like "W*" Then
        'do nothing
    ElseIf s Like "SMP*" Then
        'do nothing
    Else
        ShtRec.Rows(i).Delete
    End If
Next i

Application.ScreenUpdating = True
End Sub

 

[Yard]

Or, if you want the list of possible string matches to be more easily maintained, you could put them into an array and loop through that:

Public Sub ClearColB2_V2()
Dim i As Long, j As Long, LR As Long, s As String, v As Variant, bDel As Boolean
Dim ShtRec As Excel.Worksheet

v = Array("W*", "SMP*")
Set ShtRec = Sheets(gstrRec)

LR = ShtRec.Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = LR To 6 Step -1
    s = CStr(ShtRec.Range("B" & i).Value)
    bDel = False
    For j = LBound(v) To UBound(v)
        If s Like v(j) Then
            bDel = False
            Exit For
        Else
            bDel = True
        End If
    Next j
    If bDel Then ShtRec.Rows(i).Delete
Next i

Application.ScreenUpdating = True
End Sub

 

[JackDanIce]

You may find this suggestion quicker method than looping:

Sub DeleteNotNeededRows()
 
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
 
Dim r As Long, c As Long
 
With ActiveSheet
    If .AutoFilterMode Then .AutoFilterMode = False
End With
 
If Range("B" & Rows.Count).End(xlUp).Row > 6 Then
    r = Range("B" & Rows.Count).End(xlUp).Row
    c = Cells(6, Columns.Count).End(xlToLeft).Column
    With Range(Cells(6, 1), Cells(r, c))
        .AutoFilter
        .AutoFilter field:=2, Criteria1:="<>W*", Operator:=xlAnd, Criteria2:="<>SMP*"
        .Offset(1, 0).Resize(r - 1).Rows.Delete
    End With
    ActiveSheet.AutoFilterMode = False
Else
    MsgBox "Not enough data to filter from row 6 down"
End If
 
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
 
End Sub

 

[Jon von der Heyden]

Another autofilter suggestion:

Public Sub ClearColB2()
    Dim rngVals As Range
    Dim vararrCriteria As Variant, lngItem As Long
    
    With Sheets(gstrRec)
        Set rngVals = .Range("B6:B" & .Range("B" & .Rows.Count).End(xlUp).Row)
        .AutoFilterMode = False
    End With
    
    vararrCriteria = Array("W*", "SMP*")
    
    For lngItem = LBound(vararrCriteria) To UBound(vararrCriteria)
        With rngVals
            .AutoFilter Field:=1, Criteria1:=vararrCriteria(lngItem)
            .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            .AutoFilter
        End With
    Next lngItem
End Sub

 

[JackDanIce]

Hi Jon,

Definitely a "cleaner" suggestion than mine, thanks for the improvement.

By putting the filter criteria's into an array, would this allow you to filter by more than 2 criteria's?

Thanks,
Jack

 

[cgcamal]

Hi Donai,

Another option with your code a little bit modified:

Public Sub ClearColB2()
Dim i   As Long, _
    LR  As Long

Dim ShtRec As Excel.Worksheet


Set ShtRec = Sheets(gstrRec)

LR = ShtRec.Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = LR To 6 Step -1

W = Left(ShtRec.Range("B" & i).Value, 1)
S = Left(ShtRec.Range("B" & i).Value, 3)

If W = "W" Then
    Z = W
ElseIf S = "SMP" Then
    Z = S
Else
    Z = "WSMP"
End If

    Select Case Z
      Case "W", "SMP"
      Case Else
      ShtRec.Rows(i).Delete
    End Select
    
Next i

End Sub

Regards

 

[Jon von der Heyden]

Hi Jon,

Definitely a "cleaner" suggestion than mine, thanks for the improvement.

By putting the filter criteria's into an array, would this allow you to filter by more than 2 criteria's?

Thanks,
Jack

Hi Jack

Thanks. Yes one could add more items to the array using this method. Although you could create an array and delete in one hit if using Excel 2007+. I tend to use this method for clients using Excel 2003. It's something I learned from PeterSSs way back...

A further improvement to this would be to loop Step 2 and use the Or operator (Criteria1 and Criteria2) with AutoFilter using lngItem and lngItem-1, effectively halving the # of iterations. But doing so one also needs to manage an odd number of criteria.