1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  3. When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Autofilter with only 6 Digits numbers

Discussion in 'VBA Macros' started by jamesexcel1970, Mar 18, 2017.

  1. jamesexcel1970

    jamesexcel1970 Member

    Messages:
    85
    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:


    upload_2017-3-25_12-11-26.png

    Let me know if you need any further information.

    Cheers!
    Last edited: Mar 18, 2017
  2. vletm

    vletm Well-Known Member

    Messages:
    2,768
    Did You test this way? ... write Your six numbers ... and smile?
    Screen Shot 2017-03-18 at 22.49.55.png
    If really really needs 'VBA' then ... needs information of sheet's layout and so on!
  3. jamesexcel1970

    jamesexcel1970 Member

    Messages:
    85
    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.

    upload_2017-3-19_2-34-50.png
    Last edited: Mar 18, 2017
  4. NARAYANK991

    NARAYANK991 Excel Ninja

    Messages:
    15,417
    Hi ,

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

    Narayan
  5. vletm

    vletm Well-Known Member

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

    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?
    jamesexcel1970 likes this.
  6. jindon

    jindon Well-Known Member

    Messages:
    503
    According to your picture in #3
    Code (vb):

    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
     
    RAM72 and jamesexcel1970 like this.
  7. jamesexcel1970

    jamesexcel1970 Member

    Messages:
    85
    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!
  8. vletm

    vletm Well-Known Member

    Messages:
    2,768
    Screen Shot 2017-03-19 at 20.59.21.png
    @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

    Attached Files:

    r2c2 and jamesexcel1970 like this.
  9. jamesexcel1970

    jamesexcel1970 Member

    Messages:
    85
    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!
    Last edited: Mar 19, 2017
  10. vletm

    vletm Well-Known Member

    Messages:
    2,768
    ... humm? ...
    You really need AutoFilter ... without highlites ...
    and
    just now You give up :)
    Okay ... but just check uploaded file...

    Attached Files:

    jamesexcel1970 likes this.
  11. jamesexcel1970

    jamesexcel1970 Member

    Messages:
    85
    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!
  12. vletm

    vletm Well-Known Member

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

    Attached Files:

    jamesexcel1970 likes this.
  13. YasserKhalil

    YasserKhalil Active Member

    Messages:
    724
    What about the same code of Mr. Jindon .. but add Not in this way
    Code (vb):
    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
  14. jindon

    jindon Well-Known Member

    Messages:
    503
    You mean like this?
    Code (vb):


    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
  15. jamesexcel1970

    jamesexcel1970 Member

    Messages:
    85
    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!
    Chirag R Raval likes this.
  16. vletm

    vletm Well-Known Member

    Messages:
    2,768
    @jamesexcel1970
    Did You tested my Real AutoFilter?
    ... with Buttons as You wanted!
    jamesexcel1970 likes this.
  17. jamesexcel1970

    jamesexcel1970 Member

    Messages:
    85

    Code (vb):
    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?:(
    Chirag R Raval likes this.
  18. vletm

    vletm Well-Known Member

    Messages:
    2,768
    f - o - c - u - s
    That Your 'Fantastic' isn't Your 'button'-version!
  19. jamesexcel1970

    jamesexcel1970 Member

    Messages:
    85

    Kindly let me know with simple code..Really appreciate your efforts!
    Chirag R Raval likes this.
  20. jindon

    jindon Well-Known Member

    Messages:
    503
    If you have header in A1.
    Code (vb):

    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
  21. vletm

    vletm Well-Known Member

    Messages:
    2,768
    @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'.
    Chirag R Raval likes this.

Share This Page