2

I have a filter applied on column F based on a criteria (>1) rng.AutoFilter Field:=6, Criteria1:=">1" where rng is set for the data via VBA earlier.

Now from the filtered rows I want to apply another filter on Col E (5) and cycle through each of the unique visible values in Col E and perform some comparisons on the data and determine whether to keep it or delete those rows- but I don't know what values would be shown - that depends on the first filter - how do I accomplish this?

Here is the whole code so far:

Sub CashFlowReporting()

Dim Dest, Source As Workbook
Dim DestCell As Range
Dim sh, ws, data As Worksheet
Dim x, y, r, c, m, s As Integer
Dim fname, sname, txt As String
Dim starttime, endtime, dtDate As Date
Dim ans As VbMsgBoxResult
Dim rng, rng1 As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False

starttime = Now
fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm", Title:="Select the Term Changes Query Results file.")
If fname = False Then Exit Sub

ans = MsgBox("Is " & fname & "the Term Changes Query Results excel file?", vbYesNo)

If ans = vbYes Then
    Workbooks.Open Filename:=fname
Else
    MsgBox ("Please run the cash flow report genrator again and select the query results file.")
    Exit Sub
End If

Set Source = ActiveWorkbook
Set sh = ActiveSheet

sh.Range("E:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E1").Value = "Number_Site"
Range("F1").Value = "Count Num_Site"

Range("E2").FormulaR1C1 = "=RC[-3]&RC[-1]"
r = Range("A1").End(xlDown).Row
Range("E2", Cells(r, "E")).FillDown
Columns("E:F").AutoFit

Set rng = Range("A1")
Set rng = Range(rng, rng.End(xlToRight))
Set rng = Range(rng, rng.End(xlDown))
rng.Name = "Data"

Range("A2", Range("A2").End(xlDown)).Name = "Date"
Range("E2", Range("E2").End(xlDown)).Name = "Num_site"

sh.Sort.SortFields.Clear
sh.Sort.SortFields.Add Key:=Range("Num_site") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
sh.Sort.SortFields.Add Key:=Range("Date") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With sh.Sort
    .SetRange Range("Data")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Range("F2").Formula = "=countif($E$2:$E$1000,E2)"
Range("F2", Cells(r, "F")).FillDown

rng.AutoFilter field:=6, Criteria1:=">1"
Set rng1 = rng.Rows.SpecialCells(xlCellTypeVisible)
rng1.Select

I would now want to filter based on field 5 but for each unique value within that field (cycle through it - in this case just 2 - could be more)

Here is a link to the screenshot screenshot of the data with the first filter applied on Col F, now I would like to cycle through the 2 unique values (in this case) in Col E based on this filter:

data

If there is a more elegant solution than filter then I am open to that - I have tried Pivots and advanced filters but could not figure out a solution.

Thanks in advance and all help is appreciated.

Abhi O.
  • 141
  • 1
  • 8
  • You are going to need to make an attempt at some code and post it here. It is difficult to help since the ways of dealing with duplicates depend on the end goal of the macro. What is the final purpose of this code? – Byron Wall Jun 10 '15 at 20:27
  • This is to identify suppliers whose terms have actually changed within a certain period. So if the terms changed more than once during that period (lets say 5 times) but ended up with what it was initially then there is effectively no change. I'm basically looking for a way to cycle through a filtered data-set based on unique values in a different column of the data (not the column where the first filter is applied). – Abhi O. Jun 10 '15 at 20:35

1 Answers1

3

While a Scripting.Dictionary may make locating unique values a bit easier, it only takes a couple lines of extra code to duplicate the dictionary's Exists functionality.

Dim rng As Range, ctv As Range, f As Long, vFLTR As Variant

vFLTR = ChrW(8203)

With ActiveSheet   'set this worksheet reference properly!
    If .AutoFilterMode Then .AutoFilterMode = False
    Set rng = .Cells(1, 1).CurrentRegion

    With rng
        .AutoFilter Field:=6, Criteria1:=">1"
        If Application.Subtotal(103, .Columns(5)) > 1 Then
            With rng.Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
                For Each ctv In .Columns(5).Cells.SpecialCells(xlCellTypeVisible)
                    If Not CBool(InStr(1, vFLTR, ChrW(8203) & ctv.Value & ChrW(8203), vbTextCompare)) Then
                        vFLTR = vFLTR & ctv.Value & ChrW(8203)
                    End If
                Next ctv
                vFLTR = Left(vFLTR, Len(vFLTR) - 1): vFLTR = Right(vFLTR, Len(vFLTR) - 1)
                vFLTR = Split(vFLTR, ChrW(8203))
            End With
            For f = LBound(vFLTR) To UBound(vFLTR)
                .AutoFilter Field:=5, Criteria1:=vFLTR(f)
                MsgBox "pause and look"
                .AutoFilter Field:=5
            Next f
        End If
        .AutoFilter
    End With
End With

I wrote that while waiting for you to provide the framework that it belongs in but you can certainly see the process of first collecting a unique set of visible values then cycling through them for a additional filtered column.

  • Great answer - TY! Appreciate the time and effort greatly. I can't vote up (not enough rep for me to vote the answer up) but I tried your solution and it worked perfectly. – Abhi O. Jun 10 '15 at 21:23
  • [Glad to hear you got sorted out quickly](http://stackoverflow.com/help/someone-answers). –  Jun 10 '15 at 21:25
  • I hope some poor soul doesn't come across this and have `ChrW(8203)` in their data! **1)** Might be clearer if you didn't use `vFLTR` as a `String` and `Array`. That is assign `Split` to a new variable. You could also use `Mid(vFLTR, 2, Len(vFLTR)-2)` instead of the `Left...Right` and immediately `Split` it. **2)** Any reason using `Subtotal > 1` instead of `.Columns(5).SpecialCells(xlCellTypeVisible).Count > 1`? There should be at least the header, so this won't error out. **3)** excellent bit of code to get the job done... I was going to recommend a `Dictionary`. – Byron Wall Jun 10 '15 at 21:54
  • @Byron - a) I usually don't worry about users having zero-length spaces in their worksheet data b) I tend to reuse vars whenever I can c) good point on the `Mid`; that would make nesting it into the `Split` worthwhile d) I actually usually shift down a row to the filtered region when determining visible cells; the use of subtotal was just a hangover from that practise. –  Jun 10 '15 at 22:00
  • Makes sense on `Subtotal` in that case... saves an error you have to trap if nothing is found. Just now saw the `With` below that to get past the headers. I always like `Intersect(rng, rng.Offset(1))` to get past headers. I was joking about `8203`... I had no idea what it was but I guess it [apparently does show up](http://stackoverflow.com/questions/2973698/whats-html-character-code-8203). :) – Byron Wall Jun 10 '15 at 22:09