Autofilter with only 6 Digits numbers

[jamesexcel1970]

Hello Experts.

Aim tired of getting this solutions...tried different ways before posting this.

Wanted to filter "A" column with condition with 6 digits only with VBA as rest of the filter's managed with recording.

My data consists of 78000 rows from which need only starting with 6 digits

Example:




Let me know if you need any further information.

Cheers!

 

[vletm]

Did You test this way? ... write Your six numbers ... and smile?

If really really needs 'VBA' then ... needs information of sheet's layout and so on!

 

[jamesexcel1970]

Hello Vletm.

Thanks for responding.

Actually the number may start with any number...it may contain 6 or 10 digits or so on...but wanted to filter only 6 digits numbers in filter irrespective of data it contains....It's really strait only 6 digits to filter.

Data is at work...So i just gave an example..

For me below highlighted in green are valid only start with any number must contain 6 digits.

 

[NARAYANK991]

Hi ,

Can you not use the Advanced Filter feature with a formula for the criteria ?

Narayan

 

[vletm]

@jamesexcel1970... as last time (prev case) I tried to write:
If You write that and think this then You'll get this - not that!

Sub Do_F6N()
    Application.ScreenUpdating = False
    y = 2
    With ActiveSheet
        Do
            F6N = True
            For x = 1 To 6
                N6 = Asc(Mid(.Cells(y, 1), x, 1))
                If N6 < 48 Or N6 > 57 Then F6N = False
            Next x
            If F6N Then .Cells(y, 1).Interior.ColorIndex = 15
            y = y + 1
        Loop Until .Cells(y, 1) = Empty
    End With
    Application.ScreenUpdating = True
End Sub

You used, for me, so called 'reserved words' with 'own meaning' ... did You?

 

[jindon]

According to your picture in #3

Sub test()
    Dim i As Long
    For i = 2 To Range("a" & Rows.Count).End(xlUp).Row
        Rows(i).Hidden = Cells(i, 1).Value Like "######[!0-9]*"
    Next
End Sub

 

[jamesexcel1970]

Hello Experts

@vletm your code works perfectly but highlights...But wanted to filter.

@ jindon your code works perfectly but hides which are starts with 6 digits.

What really i wanted is to filter with starts with 6 digits.

Please help.

Cheers!

 

[vletm]

@jamesexcel1970 ... but why You then send photo like above?
If You showed that 'highlite'
... check next version
... without colors but now control by clicking cell A1

 

[jamesexcel1970]

vletm

Thank you so much for the above code..

cam i have same to auto filter rather then with
Private Sub Worksheet_Selection Change(By Val Target As Range)


i just need for autofilter for "A" column with "A"

As iam doing autofilter for "B" column with starting with "A" which is working fine.

So that all filter's can work with one go...thanks.

Cheers!

 

[vletm]

... humm? ...
You really need AutoFilter ... without highlites ...
and
just now You give up
Okay ... but just check uploaded file...

 

[jamesexcel1970]

Hello Vletm.

Thanks for your efforts.

As i told you there are other filter which are running with a button which i wanted to included in the same ..

Need to filter with a button click.


Cheers!

 

[vletm]

... and next You need that someone else would click the button?
Now, You have many buttons to click!

 

[YasserKhalil]

What about the same code of Mr. Jindon .. but add Not in this way

Sub test()
    Dim i As Long
    For i = 2 To Range("a" & Rows.Count).End(xlUp).Row
        Rows(i).Hidden = Not (Cells(i, 1).Value Like "######[!0-9]*")
    Next
End Sub

 

[jindon]

@ jindon your code works perfectly but hides which are starts with 6 digits.

What really i wanted is to filter with starts with 6 digits.

You mean like this?

Sub test()
    Dim i As Long
    For i = 2 To Range("a" & Rows.Count).End(xlUp).Row
        Rows(i).Hidden = Not Cells(i, 1).Value Like "######[!0-9]*"
    Next
End Sub

 

[jamesexcel1970]

Thank you so very much!

it works...but takes lot of time to get the result.

Can this happen by auto filter instead of hiding the rows to do this quick.


Cheers!

 

[vletm]

@jamesexcel1970
Did You tested my Real AutoFilter?
... with Buttons as You wanted!

 

[jamesexcel1970]

... humm? ...
You really need AutoFilter ... without highlites ...
and
just now You give up
Okay ... but just check uploaded file...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$A$1" Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        With ActiveSheet
            If Not Target.Font.Bold Then
                MyStr = Empty
                y = 2
                Do
                    F6N = True
                    For x = 1 To 6
                        N6 = Asc(Mid(.Cells(y, 1), x, 1))
                        If N6 < 48 Or N6 > 57 Then F6N = False
                    Next x
                    If F6N Then
                        If MyStr <> Empty Then MyStr = MyStr & ","
                        MyStr = MyStr & .Cells(y, 1)
                    End If
                    y = y + 1
                Loop Until .Cells(y, 1) = Empty
                ary = Split(MyStr, ",")
                If .FilterMode Then .ShowAllData
                .Range("A:A").AutoFilter
                .Range("A:A").AutoFilter Field:=1, Criteria1:=(ary), Operator:=xlFilterValues
            Else
                .Range("A:A").AutoFilter Field:=1
            End If
            Target.Font.Bold = Not Target.Font.Bold
            .Range("B1").Select
        End With
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

Private Sub A_F6N()
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        With ActiveSheet
            If Not .Range("A1").Font.Bold Then
                MyStr = Empty
                y = 2
                Do
                    F6N = True
                    For x = 1 To 6
                        N6 = Asc(Mid(.Cells(y, 1), x, 1))
                        If N6 < 48 Or N6 > 57 Then F6N = False
                    Next x
                    If F6N Then
                        If MyStr <> Empty Then MyStr = MyStr & ","
                        MyStr = MyStr & .Cells(y, 1)
                    End If
                    y = y + 1
                Loop Until .Cells(y, 1) = Empty
                ary = Split(MyStr, ",")
                If .FilterMode Then .ShowAllData
                .Range("A:A").AutoFilter
                .Range("A:A").AutoFilter Field:=1, Criteria1:=(ary), Operator:=xlFilterValues
            Else
                .Range("A:A").AutoFilter Field:=1
            End If
            .Range("A1").Font.Bold = Not .Range("A1").Font.Bold
            .Range("B1").Select
        End With
        Application.EnableEvents = True
        Application.ScreenUpdating = True
End Sub

Fantastic! Mr vletm

It works..iam really sorry how come i missed..

it's really highlevel of coding i belive...hard to understand person like me who is new..but works like magic...Thank you so very much.

Please let me know if you can cut down this to simple code...Cheers.

Why so many "Cheers" buttons?

 

[vletm]

f - o - c - u - s
That Your 'Fantastic' isn't Your 'button'-version!

 

[jamesexcel1970]

f - o - c - u - s
That Your 'Fantastic' isn't Your 'button'-version!

Kindly let me know with simple code..Really appreciate your efforts!

 

[jindon]

If you have header in A1.

Sub test()
    Dim rng As Range
    With Cells(1).CurrentRegion
        Set rng = .Offset(, .Columns.Count + 2).Resize(2)
        rng(2).Formula = "=(len(a2)>=6)*(isnumber(left(a2,6)+0))*(not(isnumber(mid(a2,7,1)+0)))"
        .AdvancedFilter 1, rng
    End With
End Sub

 

[vletm]

@jamesexcel1970
... so many buttons,
because You liked those buttons (instead of click "A1") !
... and use LOWER code 'A_F6N' with Your buttons.
... and still it's with 'AutoFilter' as You have used as one 'keyword'.