Filtering the cells in a column based on a substring when there are more than 254 characters in the cells of the column

1086 views vba
-1

The code below helps to filter based on the whether the substring "678" or "28" is in the cells of column B.

    Sub FilterChars()
    Dim val As String, i As Long, myArray() As String
    Dim c As Collection
    Dim lastRow As String

    lastRow = TotalRowsBeforeFilter()
    startRowNum = 1
    Let sheetRange = "A" & startRowNum & ":" & "B" & lastRow


    Set c = New Collection

    On Error Resume Next
        For i = 2 To lastRow
            val = Cells(i, 2).Value
            If val Like "189" Or val Like "*, 678,*" Or val Like "678, *" Or val Like "*, 678" _
                Or val Like "28" Or val Like "*, 28,*" Or val Like "28, *" Or val Like "*, 28" Then
                c.Add val, CStr(val)
            End If
        Next i
    On Error GoTo 0

    ReDim myArray(0 To c.Count - 1)
    For i = 1 To c.Count
        myArray(i - 1) = c.Item(i)
    Next i
    ActiveSheet.Range(sheetRange).AutoFilter Field:=2, Criteria1:=(myArray), Operator:=xlFilterValues

Public Function TotalRowsBeforeFilter() As Long

    TotalRowsBeforeFilter = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
End Function

The code works fine and does the filters if the number of characters in a cell in coumn B is less than or equal to 254 charatcers.

If there are more than 254 characters then those cells are ignored even though "678" or "28" is present in that cell. What could I do to solve this issue?

This is how one cell of column B looks like - enter image description here

answered question

Where does str come from?

@Jeeped - Good catch!! My Bad I made a typo. it should be val and not str . Just corrected it in the edit.

1 Answer

0

Use Instr to get over the character limit and use the shorthand dictionary add method to avoid On Error Resume Next.

This code is untested as I wasn't going to retype your sample dtat from an image.

Sub FilterChars()
    Dim val As String, i As Long
    Dim c As object
    Dim lastRow As String

    lastRow = TotalRowsBeforeFilter()
    startRowNum = 1
    sheetRange = "A" & startRowNum & ":" & "B" & lastRow


    Set c = createobject("scripting.dictionary)
    c.comparemode = vbtextcompare

    For i = 2 To lastRow
        val = Cells(i, 2).Value2
        if cbool(instr(1, val, "189", vbtextcompare)) or _
           cbool(instr(1, val, ", 678", vbtextcompare)) or _
           cbool(instr(1, val, "678,", vbtextcompare)) or _
           cbool(instr(1, val, "28", vbtextcompare)) or _
           cbool(instr(1, val, ", 28,", vbtextcompare)) or _
           cbool(instr(1, val, "28,", vbtextcompare)) then
        c.item(val) = cstr(val)
    next i

    ActiveSheet.Range(sheetRange).AutoFilter Field:=2, Criteria1:=c.keys, Operator:=xlFilterValues
    'could also be
    'ActiveSheet.Range(sheetRange).AutoFilter Field:=2, Criteria1:=c.items, Operator:=xlFilterValues

end sub

There appears to be some redundancy in criteria like Like "*, 678,*" Or str Like "678, *" Or str Like "*, 678".

posted this

Have an answer?

JD

Please login first before posting an answer.