Appendix Thread 2. ( Codes for other Threads, HTML Tables, etc.)

First macro attempt for this Thread
https://www.excelfox.com/forum/showt...3203#post23203


When you add things in the F___ column, then things happen as explained here: https://www.excelfox.com/forum/showt...ll=1#post23205

_____ Workbook: FilTit.xlsm ( Using Excel 2010 32 bit )

Row\Col	A	B	C	D	E	F	G
1	Fname		FRegion		FCountry	Falan
2					u
3	rr		sh
4	ll					Big
5

Worksheet: Sheet1





The examples used in the explanation work on the data table in the next post

Code:

---

Option Explicit
'  https://www.excelfox.com/forum/showthread.php/2922-VBA-Count-filtered-rows-in-the-table?p=23201&viewfull=1#post23201
Private Sub Worksheet_Change(ByVal Target As Range)
Rem 1 what cell changes don't interest me
 If Target.Cells.Count <> 1 Then Exit Sub '  More than one cell changed, for example by pasiting new range in
 If Target.Row = 1 Then Exit Sub '        '  Row 1 is always header so of no interst for adding data
 If Target.Value = "" Then Exit Sub '    '  If we empty a cell we don't want the macro to do anything
Rem 2 find range to search
Dim Hdr As String, HdRw() As Variant, Lc As Long, Lr As Long, Fc As Long, ClmsCnt As Long
 Let Hdr = Cells.Item(1, Target.Column).Value ' we get the header from the first row in the changed column
 Let Hdr = LCase(Mid(Hdr, 2))                ' take off the  F  at the start and change to lower case
 Let Lc = Cells.Item(1, Columns.Count).End(xlToLeft).Column  ' the last column in the worksheet that has something in the first row, so this will probably
 Let ClmsCnt = Cells.Item(1, Lc).CurrentRegion.Columns.Count '  Current region  is a square range that includes the cell its applied to and goes as far as there is a spreadsheet boundry of an empty column or row, so the column count of that range will likely tell us how many columns are in our table
 Let Fc = Lc - ClmsCnt + 1                                  ' This should get us the first column of out table
Dim MtchRes As Variant
 Let MtchRes = Application.Match(Hdr, Cells.Item(1, Fc).Resize(1, ClmsCnt), 0)  '  Either this will return us an VBA error ( it won't actually error ) ,  or it will give a number of the "position along" of where it makes a match
    If IsError(MtchRes) Then MsgBox prompt:="I can't find " & Hdr & "": Exit Sub ' For the case of getting an VBA error returned I must have an incorrect header somewhere, maybe a typo in a header somewhere
Dim SrchClm As Long: Let SrchClm = MtchRes + Fc - 1    '  This should give us the number of the column in the table that I want to search
 Let Lr = Cells.Item(Rows.Count, SrchClm).End(xlUp).Row ' This should return the last used row in that column
    If Cells.Item(Lr, SrchClm) = "" Then Let Lr = Cells.Item(Lr, SrchClm).End(xlUp).Row '  This sia bit of a bodge, and I am not sure yet why i nned this, but it appears that I first find the last row in the table if the last row is empty for this column.  Strange, but empirically it seems doing it again gets over this problem. I also saw that doing it again if I did get the correct last row with something in it, then doing it again will get me down to row 1.  So it looks like perhaps it initially gety the end of the table. That is OK if the column to search has a last table entry.  otherwise doing it again gets me down to the löast used row for that column
Dim SrchRng As Range: Set SrchRng = Cells.Item(2, SrchClm).Resize(Lr - 1, 1) '  This will be the column range to search
Dim arrSrch() As Variant: Let arrSrch() = SrchRng.Value '  gets an array of the search range
Rem 3 Get array of matches by clever way that only Alan, The Fuhrer, knows about
Dim arrSrchF() As Variant
 Let arrSrchF() = Evaluate("=IF({1},SEARCH(" & """" & Target.Value & """" & "," & SrchRng.Address & "))")
Rem 4 Get results from arrHits()
Dim TRws As Long, HitRws As Long, strHits As String
Dim Cnt As Long  '      arrSrchF()  will look like this,  https://i.postimg.cc/gJQ121Wq/arr-Srch-F.jpg  , each element has something similar to the  .Match  result, so we can use that to see if we got a match or not
    For Cnt = 1 To UBound(arrSrchF(), 1)
        If IsError(arrSrchF(Cnt, 1)) Then
        ' if error than no hit
        Else
        Let strHits = strHits & arrSrch(Cnt, 1) & vbCr & vbLf  '  This gives the actual value of a hit, or rather adds it to a long text string for the output
        End If
       
    Next Cnt
 Let strHits = Left(strHits, Len(strHits) - 2)  ' This takes off the last  vbDr & vbLf  which we doin't need
Rem 5 Final output
Dim arrFnd() As String: Let arrFnd() = Split(strHits, vbCr & vbLf, -1, vbBinaryCompare) '  This splits the output string by the  line seperator, and returns a 1 dimansional array where each elemnt is effectively a matched row value.  The number of elements of this array will be a convenient way on the next line to get the numkber of row match results we got
 Let strHits = Hdr & " Filter by " & Target.Value & " will get " & UBound(arrFnd()) + 1 & " rows " & vbCr & vbLf & vbCr & vbLf & strHits & vbCr & vbLf
 Let strHits = strHits & vbCr & vbLf & "Total rows in " & Hdr & " column was " & Lr - 1
 MsgBox prompt:=strHits: Debug.Print strHits
End Sub

---

_____ Workbook: FilTit.xlsm ( Using Excel 2010 32 bit )

Row\Col	H	I	J	K
1	name	region	country	alan
2	Pascale Murray	Västra Götalands län	Mexico	Big Cock
3	Harrison Irwin	South Gyeongsang	Spain	Big Brain
4	Kim Buckner	Irkutsk Oblast	Indonesia	Hansome
5	Mia Cruz	Nova Scotia	Germany	Big Castle
6	Sierra Howe	Oslo	India
7	Kyra Osborne	Campania	India
8	Matthew Jenkins	Texas	Norway
9	Adria Mayo	Oaxaca	Germany
10	Patricia Rodriguez	Junín	Netherlands
11	Nolan Hurst	Azad Kashmir	Peru
12	Cleo Munoz	Free State	Brazil
13	Scarlet David	Ulster	Belgium
14	Madonna Parks	Pernambuco	Canada
15	Derek Cain	Donetsk oblast	Norway
16	Zorita Harvey	Aisén	Turkey
17	Lev Stout	Northern Cape	Turkey
18	George Blake	San José	Russian Federation
19	Adele Burgess	Victoria	Singapore
20	Curran Herring	Prince Edward Island	Philippines
21	Jenette Stanton	Cordillera Administrative Region	Chile
22	Katell Whitaker	Flintshire	Poland
23	Phillip Hunter	Brussels Hoofdstedelijk Gewest	Norway
24	Martena Cotton	Western Australia	Poland
25	Brenda Mclaughlin	Poitou-Charentes	Netherlands
26	Brett Blackwell	San José	China
27	Alma Curtis	Innlandet	Ireland
28	Ainsley Battle	Lubelskie	South Africa
29	Glenna Gregory	Pernambuco	Sweden
30	Julian Castillo	Yucatán	Italy
31	Beatrice Whitley	Bremen	China
32	Brooke Daniel	Uttarakhand	Chile
33	Nicholas Douglas	Australian Capital Territory	Turkey
34	Kelly Ware	Vestland	United States
35	Peter Velazquez	Nevada	Ireland
36	Erasmus Hughes	Friesland	South Africa
37	Reese Bray	Andhra Pradesh	China
38	MacKenzie Ray	La Libertad	Chile
39	Audra Nolan	Central Region	Germany
40	Jin Mcmillan	Cajamarca	South Korea
41	Alec Guzman	São Paulo	Brazil
42	Ciara Hurst	Michoacán	Vietnam
43	Yasir Rollins	Noord Brabant	Italy
44	Logan Lara	Zeeland	Sweden
45	Wayne Holcomb	Andaman and Nicobar Islands	Pakistan
46	Madonna Ayers	Northern Cape	Nigeria
47	Christian Graves	North Region	Belgium
48	Ingrid Harper	Westmorland	China
49	Rafael Emerson	Ð?ng Nai	France
50	Chandler Burks	South Island	Chile
51	Jaquelyn Hendrix	Vorarlberg	Spain
52	Roanna Reynolds	Niger	Sweden
53	Chandler Baldwin	Henegouwen	Poland
54	Wanda Luna	Western Australia	New Zealand
55	Blake Herring	Franche-Comté	Ireland
56	Odette Gordon	Metropolitana de Santiago	Australia
57	Ignacia Randolph	Loreto	Russian Federation
58	Haley Ewing	lódzkie	France
59	Keaton Mckay	Queensland	New Zealand
60	Yeo Allen	Kirkcudbrightshire	Brazil
61	Chester Whitfield	Sevastopol City	Belgium
62	Kadeem Calhoun	Ontario	Colombia
63	Clinton Mcgowan	Chhattisgarh	Norway
64	Macon Burke	Nariño	Chile
65	Yen Griffin	Ulyanovsk Oblast	Peru
66	Dieter Christensen	Marche	Chile
67	Rafael Ferguson	Gelderland	South Korea
68	Rana Graves	Piura	Sweden
69	Hilel Marshall	Tasmania	India
70	Lev Osborne	Berlin	Belgium
71	Amela Benjamin	Hamburg	Sweden
72	Brock Gomez	Niedersachsen	Ukraine
73	Raphael Gonzalez	Östergötlands län	Vietnam
74	Armando Roach	Boyacá	Spain
75	Iona Glenn	Zhongnán	Ireland
76	Rose Brennan	Qu?ng Ngãi	Sweden
77	Adara Mcguire	La Rioja	New Zealand
78	Jarrod Mccarthy	Pomorskie	Colombia
79	Aiko Hardy	Ulster	Norway
80	Blythe Knapp	Catalunya	Poland
81	Jameson Ramsey	Massachusetts	Canada
82	Idona Flynn	Noord Holland	India
83	Rogan Mcneil	Mpumalanga	Belgium
84	Kiayada Spencer	Vichada	Nigeria
85	Dillon Dunlap	Waals-Brabant	Belgium
86	Anastasia Powers	Hessen	Italy
87	Neil Walter	Yukon	Norway
88	Jin Gilliam	Provence-Alpes-Côte d'Azur	Norway
89	Stephanie Mann	Puntarenas	South Africa
90	Petra Sellers	Queensland	Colombia
91	Armando Fuentes	Provence-Alpes-Côte d'Azur	Peru
92	Amy Eaton	Westmorland	Peru
93	Kessie Parsons	San José	United Kingdom
94	Bo Irwin	Kherson oblast	Pakistan
95	Ariel Rice	Huádong	India
96	Chancellor Ratliff	Poltava oblast	Ireland
97	Jana Hickman	Kirov Oblast	Vietnam
98	Halla Hodges	Podkarpackie	Austria
99	Tiger Gay	Chiapas	China
100	Kenneth Delacruz	Newfoundland and Labrador	Indonesia
101	Mikayla Pacheco	Donetsk oblast	Nigeria

Worksheet: Sheet1

For later

Second main macro attempt for this Thread
https://www.excelfox.com/forum/showt...ll=1#post23220


Note: This only filters by the last things added in the Filters. See here https://www.excelfox.com/forum/showt...ll=1#post23240

Code:

---

Private Sub Worksheet_Change(ByVal Target As Range)
Rem 1 what cell changes don't interest me
 If Target.Cells.Count <> 1 Then Exit Sub '  More than one cell changed, for example by pasiting new range in
 If Target.Row = 1 Then Exit Sub '        '  Row 1 is always header so of no interst for adding data
' If Target.Value = "" Then Exit Sub '    '  If we empty a cell we don't want the macro to do anything
Rem 2 Put main range in dictionary
Dim arrOut() As Variant, Ws3 As Worksheet: Set Ws3 = ThisWorkbook.Worksheets.Item(3)
Ws3.Columns(Ws3.Range("A1").CurrentRegion.Columns.Count + 1).Resize(, 40).EntireColumn.Delete Shift:=xlToLeft
Dim ClCnt As Long
 Let arrOut() = Ws3.Range("A1").CurrentRegion.Value2
 Let ClCnt = UBound(arrOut(), 2)
Dim Dick As Object
 Set Dick = CreateObject("Scripting.Dictionary")
Dim Cnt As Long
    For Cnt = 1 To UBound(arrOut(), 1)
'    Dim Ex As Variant
'    Let Ex = Dick(Haray(Cnt))
    Dick.Add Key:=Cnt, Item:=Application.Index(arrOut(), Cnt, 0) ' Each item in the dictionary is a 1 dimensional array of a single row of the data range
    Next Cnt
Debug.Print Dick.Count
Dim strRes As String
 Let strRes = "Total rows: " & UBound(arrOut(), 1) - 1 & vbCr & vbLf  '  This is the final main output string.  I do this here as the original main data range row cpunt is wanted in the results

Rem 3 determine Ffilters
Dim Lc As Long:  Let Lc = Cells.Item(1, Columns.Count).End(xlToLeft).Column  ' the last column in the worksheet that has something in the first row, so this will probably be last filter
'Dim Cnt As Long
 Let Cnt = 1
    Do While Cnt <= Lc ' this should keep going until I have considered all the  "to filter by"  columns
        If Cells.Item(1, Cnt) = "" Then
        ' I ignore empty columns
        Else
        Dim strFfts As String, strFtBy As String '  The header of the filter column ,  the value  "to be filtered by"
        Let strFtBy = Cells.Item(Rows.Count, Cnt).End(xlUp).Value ' This will be the last value, so presumably what the user last put in
            If strFtBy = Cells.Item(1, Cnt).Value Then
            ' this would be the case if the "to filter by" column was empty, ( other than the heading )
            Else
            Let strFfts = strFfts & Cells.Item(1, Cnt).Value & "," & strFtBy & " " ' For covenience later, a string has the  heading  and the  "to filter by"  together seperated by a  comma  ,
            End If
        End If
    Let Cnt = Cnt + 1
    Loop ' While Cnt <= Lc
 Let strFfts = Left(strFfts, Len(strFfts) - 1) '  take off the last space  " "  or else by spliting in next line I will get an extra empty array element
Dim Flts() As String: Let Flts() = Split(strFfts, " ", -1, vbBinaryCompare)
Rem 4  main loop for all filter columns
 Dim Ft As Long
    For Ft = 0 To UBound(Flts()) ' ===========================================================================
    Dim arrIn() As Variant
    Let arrIn() = Dick.items() '  Dick.Itams()  returns a 1 dimensional array, and in our case we put a 1 dimensional array in each item, so we have a 1 dimansional array of 1 domansional arrays, and super Alan figured out a way in the next line to turn it into a two dimensional array
    Let arrOut() = Application.Index(arrIn(), Evaluate("Row(1:" & UBound(arrIn()) + 1 & ")"), Evaluate("Column(A:" & Split(Cells(1, ClCnt).Address, "$", -1, vbBinaryCompare)(1) & ")"))
    ' At this point we made a new array from the dictionary items remaining.  The key, pseudo the index will be fucked up, example,  6  items left might have keys  1 3 4 6 8 9  but they are in order ( I hope )
    Set Dick = Nothing: Set Dick = CreateObject("Scripting.Dictionary")
        For Cnt = 1 To UBound(arrOut(), 1) '  This  is necersary to get the  array  row number and the dictionary key  in wach
    '    Dim Ex As Variant
    '    Let Ex = Dick(Haray(Cnt))
        Dick.Add Key:=Cnt, Item:=Application.Index(arrOut(), Cnt, 0) ' Each item in the dictionary is a 1 dimensional array of a single row of the data range
        Next Cnt
    Let Ws3.UsedRange.Offset(0, Ws3.UsedRange.Columns.Count + 1).Resize(UBound(arrOut(), 1), 4) = arrOut()
    Dim Hdr As String
    Let Hdr = Split(Flts(Ft), ",", 2, vbBinaryCompare)(0)
    Let strFtBy = Split(Flts(Ft), ",", 2, vbBinaryCompare)(1)
    Let Hdr = LCase(Mid(Hdr, 2))                ' take off the  F  at the start and change to lower case
    Dim MtchRes As Variant
    Let MtchRes = Application.Match(Hdr, Application.Index(arrOut(), 1, 0), 0)  '  Either this will return us an VBA error ( it won't actually error ) ,  or it will give a number of the "position along" of where it makes a match
        If IsError(MtchRes) Then MsgBox prompt:="I can't find " & Hdr & "": Exit Sub ' For the case of getting an VBA error returned I must have an incorrect header somewhere, maybe a typo in a header somewhere
    Dim Rw As Long
        For Rw = 2 To UBound(arrOut(), 1) ' -------------------------------------------------------
            If InStr(1, arrOut(Rw, MtchRes), strFtBy, vbTextCompare) = 0 Then
            'I have not found a data row in the column with the  "to be filtered by"  text
            Else
            Dim strHits As String
            Let strHits = strHits & arrOut(Rw, MtchRes) & vbCr & vbLf  '  This gives the actual value of a hit, or rather adds it to a long text string for the output
           
            Dick.Remove Key:=Rw '  I remove this data line from the dictionary
            End If
        Next Rw ' ---------------------------------------------------------------------------------
    Debug.Print Dick.Count
        If strHits <> "" Then Let strHits = Left(strHits, Len(strHits) - 2)  ' This takes off the last  vbCr & vbLf  which we don't need
    Dim Ws2 As Worksheet: Set Ws2 = ThisWorkbook.Worksheets.Item(2)
    Dim Lr2 As Long: Let Lr2 = Ws2.Range("C" & Ws2.Rows.Count & "").End(xlUp).Row
    Let Ws2.Range("C" & Lr2 + 1 & "").Offset(0, Ft + 1) = "Filtered by F" & Hdr & vbCr & vbLf & strFtBy & vbCr & vbLf & vbCr & vbLf & strHits
   
    ' Main output string
    Dim arrFnd() As String: Let arrFnd() = Split(strHits, vbCr & vbLf, -1, vbBinaryCompare) '  This splits the output string by the  line seperator, and returns a 1 dimansional array where each elemnt is effectively a matched row value.  The number of elements of this array will be a convenient way on the next line to get the numkber of row match results we got
    'Dim strRes As String
    Let strRes = strRes & Hdr & " filter by " & strFtBy & ": " & Dick.Count - 1 & " Left / Filtered " & UBound(arrFnd()) + 1 & vbCr & vbLf
    Debug.Print strRes
    Let strHits = ""
   
    Next Ft ' ================================================================================================


 Let arrIn() = Dick.items() '  Dick.Itams()  returns a 1 dimensional array, and in our case we put a 1 dimensional array in each item, so we have a 1 dimansional array of 1 domansional arrays, and super Alan figured out a way in the next line to turn it into a two dimensional array
 Let arrOut() = Application.Index(arrIn(), Evaluate("Row(1:" & UBound(arrIn()) + 1 & ")"), Evaluate("Column(A:" & Split(Cells(1, ClCnt).Address, "$", -1, vbBinaryCompare)(1) & ")"))
 Let Ws3.UsedRange.Offset(0, Ws3.UsedRange.Columns.Count + 1).Resize(UBound(arrOut(), 1), 4) = arrOut()
 Ws3.Columns.AutoFit
 Set Dick = Nothing

Rem 6 Final Results
'Dim Ws2 As Worksheet: Set Ws2 = ThisWorkbook.Worksheets.Item(2)
 Ws2.Activate
'Dim Lr2 As Long: Let Lr2 = Ws2.Range("C" & Ws2.Rows.Count & "").End(xlUp).Row
 Let Ws2.Range("C" & Lr2 + 1 & "") = strRes
 Ws2.Columns.AutoFit
 Ws2.Range("C" & Lr2 + 1 & "").Select
End Sub

---

For this post:
https://www.excelfox.com/forum/showt...ll=1#post23248

Code:

---

' 3rd macro    https://www.excelfox.com/forum/showthread.php/2922-VBA-Count-filtered-rows-in-the-table?p=23248&viewfull=1#post23248
Private Sub Worksheet_Change(ByVal Target As Range)
Rem 0 worksheets info, misc temporary stuff
Dim Ws3 As Worksheet: Set Ws3 = ThisWorkbook.Worksheets.Item(3)
 Ws3.Columns(Ws3.Range("A5").CurrentRegion.Columns.Count + 1).Resize(, 40).EntireColumn.Delete Shift:=xlToLeft  '  Clear out all but first full table in Temporary worksheet
Dim Ws2 As Worksheet: Set Ws2 = ThisWorkbook.Worksheets.Item(2)
Dim Lr2 As Long, Ws2COf As Long, strWs2 As String
 Let Lr2 = Ws2.Range("C" & Ws2.Rows.Count & "").End(xlUp).Row
Dim NxtRsRw As Long: Let NxtRsRw = Lr2 + 1
Rem 1 what cell changes don't interest me
    If Target.Cells.Count <> 1 Then Exit Sub '  More than one cell changed, for example by pasiting new range in
    If Target.Row = 1 Then Exit Sub '        '  Row 1 is always header so of no interst for adding data
    ' If Target.Value = "" Then Exit Sub '    '  If we empty a cell we don't want the macro to do anything
Rem 2 Getting test data, in a way that might be adjusted to do without Temporary worksheet
'2a this can be replaced later by text file read, either into the array or directly into the rows/lines/items of the dictionary
Dim arrOut() As Variant
 Let arrOut() = Ws3.Range("A1").CurrentRegion.Value2
Dim ClCnt As Long
 Let ClCnt = UBound(arrOut(), 2)

'2b
Dim Dik As Object
 Set Dik = CreateObject("Scripting.Dictionary")
Dim DikCnt As Long
    For DikCnt = 1 To UBound(arrOut(), 1)
'    Dim Ex As Variant
'    Let Ex = Dick(Haray(Cnt))
    Dik.Add Key:=DikCnt, Item:=Application.Index(arrOut(), DikCnt, 0) ' Each item in the dictionary is a 1 dimensional array of a single row of the data range
    Next DikCnt
Debug.Print Dik.Count

Rem 3 determine Ffilters
Dim Lc As Long:  Let Lc = Cells.Item(1, Columns.Count).End(xlToLeft).Column  ' the last column in the worksheet that has something in the first row, so this will probably be last filter
Dim CCnt As Long: Let CCnt = 1
    Do While CCnt <= Lc ' this should keep going until I have considered all the  "to filter by"  columns
        If Cells.Item(1, CCnt).Value = "" Then
        ' I ignore empty column cells
        Else
        Dim FHd As String: Let FHd = Cells.Item(1, CCnt).Value
        Dim LFt As Long: Let LFt = Cells.Item(Cells.Rows.Count, CCnt).End(xlUp).Row
        Dim FtCnt As Long, strFts As String: Let strFts = FHd  ' This will become string containing  FHeader  and  all, if any  "text to be filtered by"
            For FtCnt = 2 To LFt
                If Cells.Item(FtCnt, CCnt).Value = "" Then
                ' I ignore empty  "to be filtered by" cells
                Else
                Let strFts = strFts & "," & Cells.Item(FtCnt, CCnt).Value
               
                End If
           
            Next FtCnt
        Dim strFtBy As String
        Let strFtBy = strFtBy & strFts & "|"
        End If
    Let strFts = ""
    Let CCnt = CCnt + 1

    Loop ' While CCnt <= Lc
 Let strFtBy = Left(strFtBy, Len(strFtBy) - 1)
' At this point I have all my filters data in a full string of this type  Fname,rr,ll|FRegion,sh|FCountry,us|Falan,big  so the different filters are seperated by a  |
Rem 4  main loops for all filter bys in all columns
'4a) F___      '                      Looping for each filter ' =======================
Dim arrF__() As String: Let arrF__() = Split(strFtBy, "|", -1, vbBinaryCompare)
Dim F_ As Long
    For F_ = 0 To UBound(arrF__()) '  Looping for each filter by considering every elemnt of a string type array made by splitting  Fname,rr,ll|FRegion,sh|FCountry,us|Falan,big  by  |
    Dim Hdr As String
    Let Hdr = arrF__(F_)
    Let Hdr = Mid(Hdr, 2)  ' This will either be like  Fname,rr,ll  or for no "to be filtered by", it will be the filter column, header , like  Fname    then  in next loop like  FRegion,sh  or  just  FRegion  if the second filter column has not  "to be filtered by"
    Dim Ftd As Long: Let Ftd = 0 '  Set the count of things filterd for the header  to 0  before we go further to see if we have any, so that we can also use it in the final string result if we did not have anything  "to be filtered by"
        If InStr(1, Hdr, ",", vbBinaryCompare) = 0 Then
        ' no things to filter by for this header and Hdr is the final header already
        Else
        Dim arrFby() As String ' array of the header , and to filter bys  for this Header    It must have at least 2 elements at this stage, the header and at least 1  "to be filtered by"
        Let arrFby() = Split(Hdr, ",", -1, vbBinaryCompare)
        Let Hdr = arrFby(0) '  get the filter column header for the case that there is also some  "things to be filtered by"
        '4b)
        Dim MtchRes As Variant
        Let MtchRes = Application.Match(Hdr, Application.Index(arrOut(), 1, 0), 0)  '  Either this will return us an VBA error ( it won't actually error ) ,  or it will give a number of the "position along" of where it makes a match
            If IsError(MtchRes) Then MsgBox prompt:="I can't find " & Hdr & "": Exit Sub ' For the case of getting an VBA error returned I must have an incorrect header somewhere, maybe a typo in a header somewhere
        '4c) This loops as many times as we have  "to be filterd bys"  for a particular filter column
        Dim FbyCnt As Long  ' Looking for each "to be filtered by" in the table +++++++
            For FbyCnt = 1 To UBound(arrFby()) ' Note 1 is the second one, which is the first thing to filter by
            Let Ws2COf = Ws2COf + 1 ' running offset for temporary extra Ws2 output
            'Dim strFtBy As String
            Let strFtBy = arrFby(FbyCnt) ' strFtBy  is now the single value
            Dim Rw As Long ' This loop effectively removes / filters out  lines/rows  by removing the line from the dictionary ,  2 beacuse we don't consider the header row
                For Rw = 2 To UBound(arrOut(), 1) ' -------------------------------------------------------
                    If InStr(1, arrOut(Rw, MtchRes), strFtBy, vbTextCompare) = 0 Then
                    'I have not found a data row in the column with the  "to be filtered by"  text
                    Else
                    Dim strHits As String
                    Let strHits = strHits & arrOut(Rw, MtchRes) & vbCr & vbLf  '  This gives the actual value of a hit, or rather adds it to a long text string for the output, the individual values seperated by  a  line ( vbCr & vbLf)    This can be used conveniantly by spliting by the line to get the  count
                    Dik.Remove Key:=Rw '  I remove this data line from the dictionary
                    End If
                Next Rw ' -------------------------------------------------------------
            '4d)  results info from each  "to be filtered by"
            Debug.Print Dik.Count ' this will be 1 more than the rows we are intersted in ( 1 more because we don't consider the header row )
                If strHits <> "" Then Let strHits = Left(strHits, Len(strHits) - 2)  ' This takes off the last  vbCr & vbLf  which we don't need
            Dim arrFnd() As String: Let arrFnd() = Split(strHits, vbCr & vbLf, -1, vbBinaryCompare) '  This splits the output string by the  line seperator, and returns a 1 dimansional array where each elemnt is effectively a matched row value.  The number of elements of this array will be a convenient way on the next line to get the numkber of row match results we got
            Let Ws2.Range("C" & NxtRsRw & "").Offset(0, Ws2COf) = "Total rows: " & UBound(arrOut(), 1) - 1 & vbCr & vbLf & "F" & Hdr & " filterd by " & strFtBy & ":" & vbCr & vbLf & (UBound(arrOut(), 1) - 1) - (UBound(arrFnd()) + 1) & " Left / Filtered " & UBound(arrFnd()) + 1 & vbCr & vbLf & strHits  ' ths is a temporary output that gives info for each filter by result
            Let Ftd = Ftd + UBound(arrFnd()) + 1
            '4e) At this point we have done a Filter, reduced the elements in the dictionary, so we must remake the main array again
            Dim arrIn() As Variant
            Let arrIn() = Dik.items() '  Dik.Itams()  returns a 1 dimensional array, and in our case we put a 1 dimensional array in each item, so we have a 1 dimansional array of 1 domansional arrays, and super Alan figured out a way in the next line to turn it into a two dimensional array
            Let arrOut() = Application.Index(arrIn(), Evaluate("Row(1:" & UBound(arrIn()) + 1 & ")"), Evaluate("Column(A:" & Split(Cells(1, ClCnt).Address, "$", -1, vbBinaryCompare)(1) & ")"))
                With Ws3.UsedRange
                Let .Offset(0, .Columns.Count + 1 + F_).Resize(1, 1) = "Total rows: " & UBound(arrOut(), 1) - 1 & vbCr & vbLf & "F" & Hdr & " filterd by " & strFtBy & ":" & vbCr & vbLf & (UBound(arrOut(), 1) - 1) - (UBound(arrFnd()) + 1) & " Left / Filtered " & UBound(arrFnd()) + 1 & vbCr & vbLf & strHits
                Let .Offset(5, .Columns.Count + 1).Resize(UBound(arrOut(), 1), 4) = arrOut()
                End With
            Let strHits = ""
            ' At this point we made a new array from the dictionary items remaining.  The key, pseudo the index will be fucked up, example,  6  items left might have keys  1 3 4 6 8 9  but they are in order ( I hope )
            Set Dik = Nothing: Set Dik = CreateObject("Scripting.Dictionary")
                For DikCnt = 1 To UBound(arrOut(), 1) '  This  is necersary to get the  array  row number and the dictionary key  in wach
            '    Dim Ex As Variant
            '    Let Ex = Dick(Haray(Cnt))
                Dik.Add Key:=DikCnt, Item:=Application.Index(arrOut(), DikCnt, 0) ' Each item in the dictionary is a 1 dimensional array of a single row of the data range
                Next DikCnt
            Dim strFbys As String
            Let strFbys = strFbys & strFtBy & " " '  this gives us a string like for example if there were two "to be filtered by things"  rr  and  ll  then the string will finally be  rr ll
            Next FbyCnt '  ' Looking for each "to be filtered by" in the table ++++++++
        Dim strRes As String
'        Let strRes = strRes & Hdr & " filter: " & Dik.Count - 1 & " Left / Filtered " & Ftd & vbCr & vbLf
       
        End If
    Let strRes = strRes & Hdr & " filter " & strFbys & ": " & Dik.Count - 1 & " Left / Filtered " & Ftd & vbCr & vbLf  '  This is the main wanted output  - total for each filter    The  Dik.Count  at this point will be from the last made which will be what left after we went through all the  "to be filtered by"    The  Ftd  was a running total  for the  filter header  and the  strFbys  a string with all the "things to be filtered by" seperated by a space
    Let strFbys = ""
    Next F_  ' ==== looping for each filter ===========================================

Rem 5  Main output results
Debug.Print strRes
 Let Ws2.Range("C" & NxtRsRw & "") = strRes
 Ws2.Columns.AutoFit
 Ws2.Activate
 Ws2.Range("C" & NxtRsRw & "").Select
 Ws3.Columns.AutoFit
End Sub

---

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

lateragain


https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=oVb1RfcSHLM&lc=UgwTq-jZlZLnLQ5VB8Z4AaABAg.9Hroz-OyWog9tYjSMc1qjA
https://www.youtube.com/watch?v=0pbsf6sox34&lc=Ugxp9JFvvejnqA68W1t4AaABAg
https://www.youtube.com/watch?v=kfQC-sQxMcw&lc=UgyCxQWypNIhG2nUn794AaABAg.9q1p6q7ah839t UQl_92mvg
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgyOh-eR43LvlIJLG5p4AaABAg.9isnKJoRfbL9itPC-4uckb
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=Ugy1B1aQnHq2WbbucmR4AaABAg. 9isY3Ezhx4j9itQLuif26T
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgxxajSt03TX1wxh3IJ4AaABAg. 9irSL7x4Moh9itTRqL7dQh
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=Ugxa2VYHMWJWXA6QI294AaABAg. 9irLgSdeU3r9itU7zdnWHw
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgwJAAPbp8dhkW2X1Uh4AaABAg. 9iraombnLDb9itV80HDpXc
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgzIzQ6MQ5kTpuLbIuB4AaABAg. 9is0FSoF2Wi9itWKEvGSSq
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgykemWTw-fGoPwu8E14AaABAg.9iECYNx-n4U9iK75iCEaGN
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgykemWTw-fGoPwu8E14AaABAg.9iECYNx-n4U9iK7XF33njy
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugy_1xkcndYdzUapw-J4AaABAg.9iGOq_leF_E9iKCSgpAqA1
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugy_1xkcndYdzUapw-J4AaABAg.9iGOq_leF_E9iKCy--3x8E
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwNaJiNATXshvJ0Zz94AaABAg. 9iEktVkTAHk9iF9_pdshr6
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgykemWTw-fGoPwu8E14AaABAg.9iECYNx-n4U9iFAZq-JEZ-
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgxV2r7KQnuAyZVLHH54AaABAg. 9iDVgy6wzct9iFBxma9zXI
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugx12mI-a39T41NaZ8F4AaABAg.9iDQqIP56NV9iFD0AkeeJG
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwnYuSngiuYaUhEMWN4AaABAg. 9iDQN7TORHv9iFGQQ5z_3f
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwJ3yzdk_EE98dndmt4AaABAg. 9iDLC2uEPRW9iFGvgk11nH
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgyDWAVqCa4yMot463x4AaABAg. 9iH3wvUZj3n9iHnpOxOeXa
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwvLFdMEAba5rLHIz94AaABAg. 9iGReNGzP4v9iHoeaCpTG8
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugy_1xkcndYdzUapw-J4AaABAg.9iGOq_leF_E9iHpsWCdJ5I
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

KJHDHkj

Some extended explanations for this post
https://www.excelfox.com/forum/showt...ll=1#post23261

This is approximately what it does/ should do.…………..
There are filter columns in the first worksheet, Filters Something like this https://i.postimg.cc/CZ3KMNk3/First-...et-filters.jpg


There is a table somewhere, something like this: https://www.excelfox.com/forum/showt...ll=1#post23209


Here are both the filter tables and the and main table, shown together for clarity, https://i.postimg.cc/CnM60PT4/Filter...bles-Sandy.png , but note we would not normally see the main table as that would likely be in a text file somewhere.

We consider all text in a filter, starting from the left and then move on to the next filter. The text in the filter is the text to find in a particular column, and if we find it in a row, then we remove/filter out that entire row of the table

Simplified example

Code:

---

Before filtering
F1  F2  F3                              1      2      3
a    b    cc                            xy    yx    xy
d                                          af    ff    cch
rr                                          xy    vx    zy
                                            ax    tt    tt
                                            ww  rt    ff
                                            gg  btt    gg                                   
                                          xxx  yy    zz
                                          Trr    gg    gg   
                                         
After filtering
F1  F2  F3                            1      2      3
a    b    cc                            xy    yx      xy                                         
d                                        xy    vx    zy
                                          ww    rt    ff
                                          xxx  yy    zz

---

(colours are just added for demonstration purposes)
In that example,
_ for Filter1 , the a filtered out the second and forth rows, - in the results they have gone/been removed/ deleted. Similarly the rr in the first filter resulted in the last row being removed.
_ In Filter2 , the b was responsible for filtering out a row
_ Filter3 did nothing: Despite the presence of a cc in the second line of the original table, by the time we considered the third filter, the original second line had already been removed by Filter1

Some underlining coding ideas
Collecting/ Text/ Split stuff ("Dictionaries")
As we proceed in the coding we will collect information, often in the forms of long text strings, in a particular format. For example if we collected this
"af ff cc" & vbCr & vbLf & "ax tt tt"
, then we have a chance to display directly those rows, since the two characters, vbCr and vbLf are "invisible characters" which create a new line in many pront or display options, so we would typically see it displayed as
af ff cc
ax tt tt
In addition we have a particularly useful function , Split , which allows us to split by any character or characters, so that, in that example a split by vbCr & vbLf would give as a 1 dimensional array like this sort of representation in coding,
Arr(0)="af ff cc"
Arr(1)="ax tt tt"
or like this
{"af ff cc" , "ax tt tt"}
That further lends itself to useful things like counting the array elements and storing and manipulating 1 dimensional arrays, which computers do very well: Text and 1 dimensional arrays seem to be fundamental computers. In addition I have found some neat ways to turn 1 dimensional arrays into 2 dimensional arrays, ( and visa versa ) , which is what we as humans like to see, in Tables and things

The final output wanted is collected in a single text string at various tines as we go along.

I introduce the first time a thing called a dictionary. For now will leave it at that is it like an internal held in computer memory list, not directly a VBA thing, but accessible from VBA

More specific coding description
This is approximately how it works , in simple words.

Rem 0
'0a)
I have to tell Excel a bit about some things/objects/variables, For example I say where worksheets are, or what names they have.
It makes it easier and safer sometimes to get some things well defined from the start
'0b)(i)
The coding is designed to be as flexible and dynamic as possible, so that it requires no or little change to work on, for example, more added Filter columns. So we try to get the filter array in such a way that will work for different filters and table size.
'0b)(ii)
In this section we produce a single string of all the filter information we need, so for the example considered so far, we would obtain something like this
Fname,rr,ll|FRegion,sh|FCountry (A Split of this data by | (which we will do later) will either give the header if the filter column is empty or the header and the “things to be used to filter out rows” all separated by a column, for example the first would be
Fname,rr,ll

We are finished with getting the Filter data. This can be used from Rem 2. But, we need now to obtain the main table data and put it in memory, because in this coding version we don’t have any Table data in the Excel file

Rem 1
We bring in a text file, our main table, and we split it up pseudo into a 1 dimensional array of 1 dimensional arrays, that is to say an array whole elements themselves are arrays, effectively the inner arrays are a row in the table. I say pseudo, as rather than use a VBA array we use a thing called a dictionary which is an internal memory thing which can be manipulated very efficiency. You can think of that dictionary as something like a long list, and each element/row in that list can be an array, ( or most anything else, but for us an array is convenient). So the elements/row in the list our internal 1 dimensional arrays, and the outer array holding them is our dictionary/list thing.
So for our previous example we would have for the full initial table which can be visualised as something like this, held efficiently in internal memory.
{H1 , H2 , H3}
{xy , yx , xy}
{af , ff , cch}
{xy , vx , zy}
{ax , tt , tt}
{ww , rt , ff}
{gg , tt , gg}
{xxx , yy , zz}
That lends itself nicely to getting at the data via multiple co ordinates , pseudo coding like
Dictionary (row) (column)
It works very similar to a 2 dimensional array system , or grid reference system. My guess is that 2 dimensional array and screen display ideas are held in memory like that, and thinking about that in a lateral sort of way is how I have come to do things in Excel and VBA much better than anyone ever did before, as they lacked my open minded broad way of thinking, (or they lacked my stupidity, often I can’t understand their explanations of why something can’t be done, so I just carry on and sometimes find a way to do it anyway. )

So more specifically I bring in my table from a csv text file. We bring it all in as a single string, in one go.
Conventionally the lines in a text file are, as many line/ row things in computers, are represented in the string by a vbCr & vbLf . So a Split by that gives a 1 dimensional array whose elements are a string, where in that string the individual values are separated by a comma

Rem 2
'2a) We have a main outer loop which is considering all filters. A Split using the | ( which we put in to separate the individual filters), will give us an array, each element having all the info we need for a particular filter, allowing us to loop by that array
'2b) The text in a single filter can be turned into an array by a Split using the comma , ( which we put in the entire string) for all filter texts.
'2b(i) The first element in the last made array will be the Filter header name
'2b)(ii) The first element in the last made array will be the Filter header name, and we try to find that in the main table first row, that tell us where in the main table the column we are interested in is. This way the order of where the columns are in the main table is not important

Rem 3 Filter out by loop
This next bit is the main thing that effectively takes the entire row out in the main table when the bit of text, like rr ( the "filter out by", or in my coding FtBy ) is found in that column in the row, such as if in that column we had Pascale Murray

Here is that coding bit, and we will move on to analysing that in the next post

Code:

---

        Rem 3  Filter out by loop
        Dim FtbyCnt As Long
            For FtbyCnt = 1 To UBound(arrFtbys()) ' ----------Filter out by loop-----------------
            Dim Ftby As String
            Let Ftby = arrFtbys(FtbyCnt)
            Dim Sperm As Variant '  dicloop dicloop dicloop dicloop dicloop dicloop
                For Each Sperm In Dik '  Sperm becomes the next dictionary  Key  Every time this is re done,  there will be less  Sperm  so this line and way of doing it means we are not looking in any found and removed in a previous of this, since they are not in  Dik  anymore
                    If InStr(1, Dik(Sperm)(MtchRes - 1), Ftby, vbBinaryCompare) = 0 Then
                    ' did not find the  "thing to filter out by"
                    Else ' we have a row now that needs to be removed, ans some note of which will be helpful to build the final results
                    Dim FOutDel As String:
                    Let FOutDel = FOutDel & Dik(Sperm)(MtchRes - 1) & vbCr & vbLf ' This will build us a list of matched cell content
                    Dik.Remove Key:=Sperm '  I remove this data line from the dictionary
                    End If
               
                Next Sperm ' dicloop dicloop dicloop dicloop dicloop dicloop dicloop
            Let FOutDel = Left(FOutDel, Len(FOutDel) - 2)
            Let FOutDel = "Filterd out by """ & Ftby & """" & vbCr & vbLf & FOutDel                      '  ***Add an extra line at the front to say what I am filtering out by
            Debug.Print FOutDel
            Debug.Print "Filtered Out " & UBound(Split(FOutDel, vbCr & vbLf, -1, vbBinaryCompare))        ' ***that  extra line  at the front gives one too many, but as arrays from  Split  start at  indicie/index  0  then the upper bound value is one less than the count of elements,  so these two things cancel themselves out like  -1 +1
            Let RwsCnt = Dik.Count
            Debug.Print "Left is: " & RwsCnt
            Dim FOutCnt As Long
            Let FOutCnt = FOutCnt + UBound(Split(FOutDel, vbCr & vbLf, -1, vbBinaryCompare))
            Let FOutDel = ""
            Next FtbyCnt ' --------------Filter out by loop--------------------------------------
        Debug.Print "Total rows/lines removed for filter " & Hdr & " was " & FOutCnt & vbCr & vbLf

---

Rem 3 Filter out by loop , the coding section from last post…..

To explain what this code section does with an example:
If rr is found in a cell in a column, for example if we had in a cell Pascale Murray, then the entire row in which that cell is, in the main table, will be effectively removed in the main table.
The loop is considering a single filter, doing sequentially For all "bits to be filtered out by". ( In this example the rr is a "bit to be filtered out by". It might be done just once or for as many times as there are cells with "bits to be filtered out by" in a Filter column. Example, for a Filter looking like this
Fname
ll
rr
, the loop would be done twice.

The loop starts at a count of 1, despite the fact that we use that to access the elements of the 1 dimensional array, arrFtbys() which was obtained from a Split, ( Let arrFtbys() = Split(Hdr, ",", -1, vbBinaryCompare) ), and consequently starts at an indicia of 0, rather than 1. The reason for this is that we organised that the first element was the table header which is not considered when looking for rows/lines to be removed/filtered out

'3b dicloop
This is the clever bit, and the first time done so far
Our dictionary , Dik , holds all lines in the table, each Dik element/ line has effectively a complete line of the main table
To refresh our memory of how a dictionary thing is organised: Each element/ line in it has two things associated with it,
Key:=____ and Item:=____
The Item is what is actually held, in our case a line from the main table.
The Key is just the reference or address to it. It does not matter what the key is, a name, number, (in fact it can be almost anything). It is simply something which must be unique. It is what VBA or a computer in general will use to find the main item. Think of it as if someone want to get at a House, the Item. You would unlikely tell them all about the House item, rather you would tell them something about it , which might be a variety of things, such as the address or specific directions to get exactly to it. The only thing that any of those things have in common is that they must be unique, otherwise it would not work: you can’t have two different thing’s in exactly the same place.

For some reason, (I personally don’t know why), if I do the typical VBA looping option way of a For Each Next loop in the case of a dictionary, then the thing that is looped through is not all the actual main Item thing, but rather the Keys. In this coding the Sperm then becomes each key. That is not a problem, as ,long as we know it. If we want to get at the item considered at any loop then this syntax allows us to get at it
Dik(Sperm)
, assuming that Dik is the object variable we chose for the dictionary
, and Sperm is the variable we used in the syntax of the VBA looping option way of a For Each Next , pseudo like
__ For Each Sperm In Dik
_-_ ___________
_-_ ___________
_-_ ' doing stuff for each Sperm
_-_ _____
__ Next Sperm

So we are looping the entire dictionary, in other words, we are effectively looping each line in the main table.
The main code line that checks for a line to be removed is this
____ If InStr(1, Dik(Sperm)(MtchRes - 1), Ftby, vbBinaryCompare) = 0 Then
To explain that in detail
We are using the Instr function.
For full details of that Instr function. see here https://learn.microsoft.com/en-us/of...instr-function
A quick shortened simplified description, enough for our usage of it , requires us just to consider the second and third arguments, with the example we have considered a few times, so pseudo it would then be like
Instr( __ , Pascale Murray , rr , __ )
If that does not find the rr , then it returns 0
So we are checking for that , in which case we woiuld do nothing, otherwise we would do something, (which would be to remove the line).
In that main line, the rr is in the variable Ftby , so that is not so difficult to understand.
The other bit, Dik(Sperm)(MtchRes - 1) , needs a bit more explanation to say how that ends up being something like Pascale Murray or any other entry from a cell in a column

We said already that Dik(Sperm) gives us an item , which is a line from the main table. Previously in the coding , '1c) we put the line in in a specific way. It is not a single text of the entire row and also not an excel range of all the cells in that row in the table. For each line it is a 1 dimensional array of the line.
For example, going right back to the main table, ( https://www.excelfox.com/forum/showt...ll=1#post23209
https://www.excelfox.com/forum/showt...ll=1#post23199 ) , and consider the original first line
, it is something of this form in the main table,

Pascale Murray

Västra Götalands län

Mexico

, and we have it held in our dictionary in this sort of pseudo form
Array{ "Pascale Murray" , "Västra Götalands län" , "Mexico" }
, and we can get at the individual elements, pseudo like this
Array(0) = "Pascale Murray"
Array(1) = "Västra Götalands län"
Array(2) = "Mexico"
Those 3 things are in a single 1 dimensional array, which is the Item in the dictionary. The entire array is accessed like Dik(Sperm)
If we want, for example, something in the column currently under consideration, then in the variable MtchRes we would have either 1, 2 or 3, depending on where the code line MtchRes = Application.Match(LCase(Mid(Hdr, 2)), arrHdrs(), 0) told us the column wasd in the main table. Since inidies in a 1 dimension array often start as 0, as is the case here, then we must modify that by -1 to get the correct indicia
Hence the specific cell value is obtained by Dik(Sperm)(MtchRes - 1). For the example we have been looking at for the first column we have like , pseudo,
Dik(Sperm)(1 - 1) = Dik(Sperm)(0) = "Pascale Murray"

If instr( ) did not return us 0 , then the Else code section bit does effectively the removing of the line in the dictionary using the appropriate syntax for the dictionary object:
Dik.Remove Key:=Sperm ' I remove this data line from the dictionary

When we next come to run the entire loop , then this line at the start , For Each Sperm In Dik , has the nice side effect of effectively looking at just the remaining lines.
This is perhaps one of the main differences in the working of this 4th main coding version, as previously we used more extensively VBA arrays, which meant we had some messy extra work to do in order make sure the arrays at any time had the appropriate content in the correct order after any lines were removed.

At this point, most of the difficult stuff has been explained.

---

Rem 5 Output
At various points some string information was put in the Immediate Window using Debug.Print code lines. This gives us a detailed extended output.
A limited amount of that information was also put in a string variable, strRes

4th macro, (macro explained in last few posts)

Code:

---

' 4th macro          https://www.excelfox.com/forum/showthread.php/2922-VBA-Count-filtered-rows-in-the-table?p=23270&viewfull=1#post23270                      https://www.excelfox.com/forum/showthread.php/2056-Appendix-Thread-2-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=23247&viewfull=1#post23247
Private Sub Worksheet_Change(ByVal Target As Range)
Rem -1 what cell changes don't interest me
    If Target.Cells.Count <> 1 Then Exit Sub              '  More than one cell changed, for example by pasiting new range in
    If Target.Row = 1 Then Exit Sub '                    '  Row 1 is always header so of no interst for adding data
    ' If Target.Value = "" Then Exit Sub '                '  If we empty a cell we don't want the macro to do anything
Rem 0 worksheets info, misc temporary stuff
'0a)
Dim WsRes As Worksheet: Set WsRes = ThisWorkbook.Worksheets("Results")
Dim WsFlt As Worksheet: Set WsFlt = ThisWorkbook.Worksheets("Filters")
Dim LcF As Long: Let LcF = WsFlt.Cells.Item(1, WsFlt.Columns.Count).End(xlToLeft).Column
    If Target.Column > LcF Then Exit Sub
Dim LrF As Long: Let LrF = Cells.Item(1).Resize(100, LcF).Find(What:="*", after:=Cells.Item(100, 1), LookIn:=xlValues, lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlPrevious, MatchCase:=False).Row
    If LrF = 1 Then MsgBox prompt:="Nothing to be filterd by": Exit Sub
'0b)(i)
Dim rngFlt As Range: Set rngFlt = Range("A1").Resize(LrF, LcF)
Dim arrFlt() As Variant
 Let arrFlt() = rngFlt.Value2
'0b)(ii)
Dim strFlts As String, Rw As Long, Clm As Long
    For Clm = 1 To LcF '  collecting the filter columns infomation as text
        If Cells.Item(1, Clm) = "" Then ' If the top cell is empy then....
        ' .... This will be an empty column, so do nozjing
        Else
        Let strFlts = strFlts & Cells.Item(1, Clm) ' This puts the header, like  Fname  at the start of the string
            For Rw = 2 To LcF '  loop down the rows in a column containing text
                If Cells.Item(Rw, Clm) = "" Then
                ' a row with a cell with nothing in it for this column under consideration
                Else
                Let strFlts = strFlts & "," & Cells.Item(Rw, Clm)
                End If
            Next Rw
        ' we are finished with a filter text so..
        Let strFlts = strFlts & "|" '    ..so add an arbritrary thing t
        End If ' this was the check for an empty column indicated by nothing in the top cell
    Next Clm '  On to the next column
 Let strFlts = Left(strFlts, Len(strFlts) - 1)
 ' at this point we have something of this form in strFlts    Fname,rr,ll|FRegion,sh|FCountry

Rem 1
' 1a) Get the text file as a long single string
Dim FileNum As Long: Let FileNum = FreeFile(1)                                    ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
' Let PathAndFileName = ThisWorkbook.Path & Application.PathSeparator & "Itchy Bollocks.txt"  '
 Let PathAndFileName = ThisWorkbook.Path & Application.PathSeparator & "Itchy BollocksAlan.txt"  '
' Let PathAndFileName = ThisWorkbook.Path & Application.PathSeparator & "data-v9i8Rbfh1ul6_1diL56pb.csv"  '
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundamental type data input...
' Let TotalFile = Space(LOF(FileNum)) '....and wot receives it has to be a string of exactly the right length
'Get #FileNum, , TotalFile
'  Or  http://www.eileenslounge.com/viewtopic.php?p=295782&sid=f6dcab07c4d24e00e697fe4343dc7392#p295782
 Let TotalFile = Input(LOF(FileNum), FileNum)
Close #FileNum
'1b) 1 dimensional array where elements are text file lines
Dim arr1D() As String: Let arr1D() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)
'1b(ii) !!!  I need the array of the header later
Dim arrHdrs() As String: Let arrHdrs() = Split(arr1D(0), ",", -1, vbBinaryCompare) ' ###  I don't want to mess with the header later when using the dictionary but I need it to match the filter header to  This array is effectively one containing the values in the first row of the main table.
'1c) put the text file lines into a  dictionary. These lines are not put in as text lines but as 1 dimensional arrray
Dim Dik As Object
 Set Dik = CreateObject("Scripting.Dictionary")
Dim DikCnt As Long
    For DikCnt = 1 To UBound(arr1D())  '                                            ###  Using  (1)  to start with will miss the header at  arr1D(0)
    Dik.Add Key:=DikCnt, Item:=Split(arr1D(DikCnt), ",", -1, vbBinaryCompare) ' Each item in the dictionary is a 1 dimensional array of a single row of the data range
    Next DikCnt
Dim RwsCnt As Long: Let RwsCnt = Dik.Count
Dim strRes As String: Let strRes = "Toltal rows: " & RwsCnt & vbCr & vbLf    '  First bit of info in the final string for output

Rem 2
'2a) Main outer loop  for Filter headers
Dim Flts() As String: Let Flts() = Split(strFlts, "|", -1, vbBinaryCompare)
Dim FltsCnt As Long
    For FltsCnt = 0 To UBound(Flts()) ' ========================================================
    Dim Hdr As String: Let Hdr = Flts(FltsCnt) '
    Debug.Print "Using Filter  " & Hdr & "    -----|---- -_-"
        If InStr(1, Hdr, ",", vbBinaryCompare) = 0 Then
        ' in this case the string in  Hdr  is just the header, and we go no further with any other looping
        Else ' at this point its time to do the innner loop for each of the  "things to look for to filtr out by"
        '2b)  a  Split  by the comma  ,  (that we put in in '0b)(ii)) wiil give all filled cell vaues , and ...
        Dim arrFtbys() As String: Let arrFtbys() = Split(Hdr, ",", -1, vbBinaryCompare)
        '2b(i)    The first element in the last made array will be the Filter header name, which we put in a variable, Hdr
        Let Hdr = arrFtbys(0)  '                    ...
        '2b)(ii)  The first element in the last made array will be the Filter header name, and we try to find that in the main table first row, that tell us where in the main table the column we are interested in is. This way the order of where the columns are in the main table is not important
        Dim MtchRes As Variant
'                        !!!  I got the array of headers  arrHdrs()  earlier    !!!
        Let MtchRes = Application.Match(LCase(Mid(Hdr, 2)), arrHdrs(), 0) '  Either this will return us an VBA error ( it won't actually error ) ,  or it will give a number of the "position along" of where it makes a match
            If IsError(MtchRes) Then MsgBox prompt:="I can't find " & LCase(Mid(Hdr, 2)) & " in the Table": Exit Sub ' For the case of getting an VBA error returned I must have an incorrect header somewhere, maybe a typo in a header somewhere
        Rem 3  Filter out by loop
        Dim FtbyCnt As Long
            For FtbyCnt = 1 To UBound(arrFtbys()) ' ----------Filter out by loop-----------------
            Dim Ftby As String
            Let Ftby = arrFtbys(FtbyCnt)
            Dim Sperm As Variant '  dicloop dicloop dicloop dicloop dicloop dicloop
                '3b dicloop
                For Each Sperm In Dik '  Sperm becomes the next dictionary  Key  Every time this is re done,  there will be less  Sperm  so this line and way of doing it means we are not looking in any found and removed in a previous of this, since they are not in  Dik  anymore
                    If InStr(1, Dik(Sperm)(MtchRes - 1), Ftby, vbBinaryCompare) = 0 Then
                    ' did not find the  "thing to filter out by"
                    Else ' we have a row now that needs to be removed, ans some note of which will be helpful to build the final results
                    Dim FOutDel As String:
                    Let FOutDel = FOutDel & Dik(Sperm)(MtchRes - 1) & vbCr & vbLf ' This will build us a list of matched cell content
                    Dik.Remove Key:=Sperm '  I remove this data line from the dictionary
                    End If
                Next Sperm ' dicloop dicloop dicloop dicloop dicloop dicloop dicloop
            Let FOutDel = Left(FOutDel, Len(FOutDel) - 2)
            Let FOutDel = "Filterd out by """ & Ftby & """" & vbCr & vbLf & FOutDel                      '  ***Add an extra line at the front to say what I am filtering out by
            Debug.Print FOutDel
            Debug.Print "Filtered Out " & UBound(Split(FOutDel, vbCr & vbLf, -1, vbBinaryCompare))        ' ***that  extra line  at the front gives one too many, but as arrays from  Split  start at  indicie/index  0  then the upper bound value is one less than the count of elements,  so these two things cancel themselves out like  -1 +1
            Let RwsCnt = Dik.Count
            Debug.Print "Left is: " & RwsCnt
            Dim FOutCnt As Long
            Let FOutCnt = FOutCnt + UBound(Split(FOutDel, vbCr & vbLf, -1, vbBinaryCompare))
            Let FOutDel = ""
            Next FtbyCnt ' --------------Filter out by loop--------------------------------------
        Debug.Print "Total rows/lines removed for filter " & Hdr & " was " & FOutCnt & vbCr & vbLf
        End If '  we were in a big  If Else  thing where a lot was done
'    Let strRes = strRes & Mid(Hdr, 2) & " filter: " & RwsCnt - FOutCnt & " Left / Filtered " & FOutCnt & vbCr & vbLf
    Let strRes = strRes & Mid(Hdr, 2) & " filter: " & RwsCnt & " Left / Filtered " & FOutCnt & vbCr & vbLf
    Let FOutCnt = 0
    Next FltsCnt ' ==============================================================================

Rem 5 Output
WsRes.Activate
WsRes.Range("A2").Select
 Let WsRes.Range("A2") = strRes

End Sub

---

Test Copy



Here is another, forth, version, FilTit4.xlsm

Detailed explanation is here https://www.excelfox.com/forum/showt...ll=1#post23247
https://www.excelfox.com/forum/showt...ll=1#post23262


These are the main three differences, summarised.

_1) I have used the dictionary object a bit more cleverly, and so have reduced the amount of manipulation with VBA arrays. There are two reasons for this:
_ one reason is simply doing it a bit better after a few tries so far at a final coding, so in other words I just got better as I went along; but also,
_ the other reason is that in this version I omit the TemporaryWorksheet worksheet which pasted out the reduced size tables as we went along, which required an extra array to be made as I went along in order to do that extra output.

_2) All the extended output information that is useful in development and fault finding, is now Debug.Printed out to the Immediate window, and all the extra worksheets are omitted. The only seen output for the user is what was originally wanted
For example, using the example used in the last few posts of this
https://i.postimg.cc/crcxL3p0/Exampl...-few-posts.jpg

, then we will only see this
https://i.postimg.cc/4YNJ7dGt/Only-r...-Tit4-xlsm.jpg


, unless we look in the Immediate window, and then we can see the extended output:

Code:

---

Using Filter  Fname,rr,ll    -----|---- -_-
Filterd out by "rr"
Pascale Murray
Harrison Irwin
Sierra Howe
Curran Herring
Blake Herring
Jarrod Mccarthy
Filtered Out 6
Left is: 94
Filterd out by "ll"
Katell Whitaker
Phillip Hunter
Brett Blackwell
Julian Castillo
Kelly Ware
Jin Mcmillan
Yasir Rollins
Yeo Allen
Hilel Marshall
Dillon Dunlap
Jin Gilliam
Petra Sellers
Chancellor Ratliff
Halla Hodges
Filtered Out 14
Left is: 80
Total rows/lines removed for filter Fname was 20

Using Filter  FRegion,sh    -----|---- -_-
Filterd out by "sh"
Azad Kashmir
Andhra Pradesh
Filtered Out 2
Left is: 78
Total rows/lines removed for filter FRegion was 2

Using Filter  FCountry,us    -----|---- -_-
Filterd out by "us"
Russian Federation
Australia
Russian Federation
Filtered Out 3
Left is: 75
Total rows/lines removed for filter FCountry was 3

---

_3) The table (from the text file) is held only in memory and is also not put or used in any temporary worksheets.

---

To test, then similar process to previously ,
_ download both files. They can be anywhere but both files should be in the same folder
_ open the excel workbook file only
_ In the first worksheet, type something in any filter, …. for example: type us in cell E3 of the first worksheet , and then hit Enter, https://i.postimg.cc/Cz0M076c/Type-us-in-cell-E3.jpg

That should result in getting the results indicated above