Find Count of filter, Advanced filter Data

[linok]

Hi Guys,

I need an assistance to plot a table using VBA. I have a huge data on which I need to apply filter, an advanced filter and find a count of the records. I am attaching a sample data with rules to filter data.

can anyone help me in this?

[mike7952]

This will work

Sub abc()
 Dim a, w, i As Long

  With CreateObject("scripting.dictionary")
    For i = 1 To 12
        .Item(Format(CDate(i & "/1/" & VBA.Year(Date)), "mmmm")) = Array(0, 0)
    Next
    With Worksheets("Data")
        a = .Range("a1").CurrentRegion
    End With
    
    For i = 2 To UBound(a)
        If .exists(a(i, 1)) Then
            Select Case a(i, 5)
                Case Is = "Applications", "Database", "Sever"
                w = .Item(a(i, 1))(1) + 1
                .Item(a(i, 1)) = Array(.Item(a(i, 1))(0), w)
                Select Case Left(a(i, 3), 3)
                    Case Is = "SWR", "HWR", "LHI"
                    w = .Item(a(i, 1))(0) + 1
                    .Item(a(i, 1)) = Array(w, .Item(a(i, 1))(1))
                End Select
            End Select
            
        End If
    Next
    Range("h2").Resize(2) = Application.Transpose(Array("Data with CI", "Total"))
    Range("i1").Resize(, .Count) = .keys
    Range("i2").Resize(2, .Count) = Application.Transpose(.items)
    Range("h1").Resize(3, .Count + 1).Borders.LineStyle = xlContinuous
 End With
End Sub

[linok]

Hi Mike, This code creates table with header and no values in it.

Also I wanted to understand logic behind the code. I am looking for 'CI' in specific column. I think above code will search for "SWR", "HWR", "LHI" in entire selected range. please correct me.

[Vikas_Gautam]

Done it.
Instructions:-
Goto to Developer Tab
Click macros
Run AutoFilter_Count Macro
You can change the Criteria Arrays where commented.

Dim CountArr() As Variant, ArrRow As Integer, AssignedGroups
Dim FindIn As Range, Found As Range, CI() As Variant, MonthArr As Variant
Sub AutoFilter_Count()
    Application.ScreenUpdating = False
    AssignedGroups = Array("Applications", "Database", "Sever") 'Add or Remove Criterias here.
    MonthArr = Array("January", "February", "March", "April", "May") 'Add or Remove Months
    ReDim CountArr(0 To 1, 0 To UBound(MonthArr))
    
    ActiveSheet.Cells(1, 1).CurrentRegion.Select
    Call AssignedGroupsFilter
    ArrRow = 0
    Call MonthFilter
    
    Selection.AutoFilter
    CIArr = Array("HWR*", "LHI*", "SWR*") 'Add and Remove Criterias here.
    'Making CI Criteria Array
    ReDim CI(0 To 0)
    t = 0
    For Each c In CIArr
        Set FindIn = ActiveSheet.Columns("C")
        Set Found = FindIn.Find(c)
        Fadd = Found.Address
        
        Do
            ReDim Preserve CI(0 To t)
            CI(t) = Found
            t = t + 1
            Set Found = FindIn.FindNext(Found)
        Loop While Found <> "" And Fadd <> Found.Address
    Next
    
    Call AssignedGroupsFilter
    Call CIFilter
    ArrRow = 1
    
    Call MonthFilter
    
    With ActiveSheet
        .Range("H1").Resize(1, UBound(MonthArr) + 1).Value = MonthArr
        .Range("H2").Resize(2, UBound(MonthArr) + 1).Value = CountArr
    End With
    
    'Removes Autofilter
    Selection.AutoFilter
    Application.ScreenUpdating = True
End Sub

Sub MonthFilter()
    Ro = 0
    For Each Mon In MonthArr
        Selection.AutoFilter Field:=1, _
                             Criteria1:=Mon, _
                             Operator:=xlFilterValues
        'Making CountArr Array
        CountArr(ArrRow, Ro) = Selection.Columns(1).SpecialCells(12).Count - 1
        Ro = Ro + 1
    Next
End Sub

Sub AssignedGroupsFilter()
    Selection.AutoFilter Field:=5, _
                         Criteria1:=AssignedGroups, _
                         Operator:=xlFilterValues
End Sub

Sub CIFilter()
    Selection.AutoFilter Field:=3, _
                         Criteria1:=CI, _
                         Operator:=xlFilterValues
End Sub

Check the attached file:-

[sktneer]

Please find the attached sheet and click on the Orange Button to get the desired output.

I have shifted your data down to row 4. And if you add more months in count table and more data in the data table, the code will count all.

[linok]

Hi Vikas & sktneer,

I get error when I change your code to suite my requirement: "autofilter method of range class failed"

I am just changing Field column as per my requirement. in my worksheet AssignedGroup column is at 18th position. so I changed it as

.AutoFilter Field:=18, Criteria1:=Array("APPLICATIONS", "SERVER", "DATABASE"), Operator:=xlFilterValues

[sktneer]

Hi Vikas & sktneer,
I get error when I change your code to suite my requirement: "autofilter method of range class failed"

That's why you should have uploaded a sample workbook with the layout as same as of your original workbook specially when you are asking help for a VBA solution and if you don't do so that simply means that you are capable enough to understand the codes provided and able to change them to suit your original workbook's layout and requirement.

[linok]

That's why you should have uploaded a sample workbook with the layout as same as of your original workbook specially when you are asking help for a VBA solution and if you don't do so that simply means that you are capable enough to understand the codes provided and able to change them to suit your original workbook's layout and requirement.

I strongly agree to you. I had to edit sample workbook so that generous peoples like you don't get confused with other junk data. Also my workbook has around 20 columns and I wanted to make sure that I am not publishing any sensitive data. I hope you understand this.

About Autofilter do you have any clue about 'Field' , I am not sure why it is not working. Please find attached file.

[mike7952]

@linok,

I'm not able to get to a computer but in your example workbook in your first post , does my code that I gave you work correctly for you?

Also going off memory I believe your requirement was to look for those 3 values SWR, HWR and LHI nothing about CI. I don't believe 3 of us got that part wrong.

[linok]

@linok,

I'm not able to get to a computer but in your example workbook in your first post , does my code that I gave you work correctly for you?

Also going off memory I believe your requirement was to look for those 3 values SWR, HWR and LHI nothing about CI. I don't believe 3 of us got that part wrong.

Yes , It does. Probably I need to see it bit closer & change it as there are no comments in the code

[mike7952]

Code is looking for those three variables in column C. Where a(i,3) is for column C

   Left(a(i, 3), 3)

[mike7952]

So then we are lookin for SWR, HWR and LHI? And Not CI

[sktneer]

In Field:= ?, you need to replace ? with column index of the criteria column in range on which an autofilter is being applied.
So if you are applying Autofilter on say range("A:G") and your criteria column is col. D, you will use Field:=4 as col. D is the fourth column in the range taken.
Now suppose your range for autofilter is range("D:G") and your criteria column is again col. D, you will use Field:=1 as in this case col. D is the first column in the range taken.

[linok]

In Field:= ?, you need to replace ? with column index of the criteria column in range on which an autofilter is being applied.
So if you are applying Autofilter on say range("A:G") and your criteria column is col. D, you will use Field:=4 as col. D is the fourth column in the range taken.
Now suppose your range for autofilter is range("D:G") and your criteria column is again col. D, you will use Field:=1 as in this case col. D is the first column in the range taken.

My Range is A:S and my filter column is R which is 18th column. I have changed this in your code. but it does not work for me. I know it could be silly mistake. looking in to it.

[mike7952]

I might be able to help if you can tell what row your data starts on and what columns is your data in? Month column, database, sever, applications column and your other column that has the SWR LHI

[linok]

I might be able to help if you can tell what row your data starts on and what columns is your data in? Month column, database, sever, applications column and your other column that has the SWR LHI

I have provided another sample file which is more realistic. I could figure out your code for 2 columns i.e "Applications, server, database" & "SWR", "HWR", "LHI". still looking for column "Month"

[linok]

I have provided another sample file which is more realistic. I could figure out your code for 2 columns i.e "Applications, server, database" & "SWR", "HWR", "LHI". still looking for column "Month"

Found line of code for remaining column as well
Mike, Your code works for me. Sorry for trouble.

[mike7952]

Month is column A witch is 1.

[sktneer]

Changed the code as per your workbook, see if this works.

[jindon]

This should work

Option Explicit

Sub test()
    Dim a, b, i As Long, myMonth
    a = Cells(2).CurrentRegion.Value
    With CreateObject("System.Collections.SortedList")
        For i = 2 To UBound(a, 1)
            myMonth = Month(DateValue(a(i, 1) & "/1"))
            .Item(myMonth) = a(i, 1): a(i, 1) = myMonth
        Next
        ReDim b(1 To 3, 1 To .Count + 1)
        b(2, 1) = "Data with CI": b(3, 1) = "Total"
        For i = 0 To .Count - 1
            b(1, i + 2) = .GetByIndex(i)
            b(2, i + 2) = 0: b(3, i + 2) = 0
        Next
        For i = 2 To UBound(a, 1)
            If Evaluate("or(""" & a(i, 5) & """={""Applications"",""Database"",""Server""})") Then
                b(3, .IndexOfKey(a(i, 1)) + 2) = b(3, .IndexOfKey(a(i, 1)) + 2) + 1
                If Evaluate("or(left(""" & a(i, 3) & """,3)={""SWR"",""HWR"",""LHI""})") Then
                    b(2, .IndexOfKey(a(i, 1)) + 2) = b(2, .IndexOfKey(a(i, 1)) + 2) + 1
                End If
            End If
        Next
    End With
    With [h1].Resize(3, UBound(b, 2))
        .CurrentRegion.Clear
        .Value = b: .Borders.Weight = 2
    End With
End Sub

[Vikas_Gautam]

I have sorted this out.
Actually the problem was because of the word "Group" behind each criteria in Field 18.
Its working now. The result is on second sheet.
Here is the revised code:-

Dim CountArr() As Variant, ArrRow As Integer, AssignedGroups
Dim FindIn As Range, Found As Range, CI() As Variant, MonthArr As Variant
Sub AutoFilter_Count()
    Application.ScreenUpdating = False
    AssignedGroups = Array("Applications Group", "Database Group", "Server Group") 'Add or Remove Criterias here.
    MonthArr = Array("January", "February", "March", "April", "May") 'Add or Remove Months
    ReDim CountArr(0 To 1, 0 To UBound(MonthArr))
    
    ActiveSheet.Cells(1, 1).CurrentRegion.Select
    Call AssignedGroupsFilter
    ArrRow = 1
    Call MonthFilter
    
    Selection.AutoFilter
    CIArr = Array("HWR*", "LHI*", "SWR*") 'Add and Remove Criterias here.
    'Making CI Criteria Array
    ReDim CI(0 To 0)
    t = 0
    For Each c In CIArr
        Set FindIn = ActiveSheet.Columns("P")
        Set Found = FindIn.Find(c)
        Fadd = Found.Address
        
        Do
            ReDim Preserve CI(0 To t)
            CI(t) = Found
            t = t + 1
            Set Found = FindIn.FindNext(Found)
        Loop While Found <> "" And Fadd <> Found.Address
    Next
    
    Call AssignedGroupsFilter
    Call CIFilter
    ArrRow = 0
    
    Call MonthFilter
    
    With Sheet2
        .Range("A1").Resize(1, UBound(MonthArr) + 1).Value = MonthArr
        .Range("A2").Resize(2, UBound(MonthArr) + 1).Value = CountArr
    End With
    
    'Removes Autofilter
    Selection.AutoFilter
    Application.ScreenUpdating = True
End Sub

Sub MonthFilter()
    Ro = 0
    For Each Mon In MonthArr
        Selection.AutoFilter Field:=10, _
                             Criteria1:=Mon, _
                             Operator:=xlFilterValues
        'Making CountArr Array
        CountArr(ArrRow, Ro) = Selection.Columns(1).SpecialCells(12).Count - 1
        Ro = Ro + 1
    Next
End Sub

Sub AssignedGroupsFilter()
    Selection.AutoFilter Field:=18, _
                         Criteria1:=AssignedGroups, _
                         Operator:=xlFilterValues
End Sub

Sub CIFilter()
    Selection.AutoFilter Field:=16, _
                         Criteria1:=CI, _
                         Operator:=xlFilterValues
End Sub

Check the attached file:-

[jindon]

linok, Thanks for the rep.

If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED. Thanks.