VBA to make a list depending on the event

[asad]

Hello All,

I have recorded (that's all I can do ) a macro that filters a set of data. At the moment it filters a set of vehicles and a set of locations. But my problem is that on daily basis, different vehicles may go to the location that is required. Thus I end up manually changing the selection of vehicles that have gone to a particular location (AVA in my case). Can I please get someone to look at the code below and tell me how I can get it to first make a list of vehicles that have "AVA" as one of the locations in the data and then create filters based on this list of vehicles.
The code is:

Sub AVA()With ActiveSheet
Dim rwnm As Long
rwnm = Range("A" & Rows.Count).End(xlUp).Row
    On Error Resume Next
    ActiveSheet.ShowAllData
    ActiveSheet.Range("A1:H" & rwnm).AutoFilter Field:=8, Criteria1:=Array( _
        "AVA", "SXS", "Depot"), Operator:= _
        xlFilterValues
    ActiveSheet.Range("A1:H" & rwnm).AutoFilter Field:=2, Criteria1:=Array( _
        "150", "151", "152", "153", "50", "52", "53", "54", "8", "9"), _
        Operator:=xlFilterValues
    Range("A1").Select
End With
End Sub

Thanks and Regards
Asad

 

[asad]

You are welcome. Glad to help

If you are interested...
Another version (simpler code) that uses late binding (no need to add a reference)
Worked for me with your data sample above

Sub aTest()
    Dim dict As Object, lastRow As Long, vData As Variant
    Dim i As Long, arrCrit As Variant
    
    'create the dictionary
    Set dict = CreateObject("Scripting.Dictionary")
    'not case sensitive - not necessary in this case b/c the keys are numbers
    dict.CompareMode = vbTextCompare
    
    'get the last row with data
    lastRow = Cells(Rows.Count, "H").End(xlUp).Row
    'pass the data to a variant array to speed up processing
    vData = Range("B2:H" & lastRow)
    
    'loop through vData and add to dictionary if column H = "AVA"
    For i = 1 To UBound(vData, 1)
        If UCase(vData(i, 7)) = "AVA" Then dict(vData(i, 1)) = Empty
    Next i
    'converts the array of numbers (dict keys) to an array of strings
    arrCrit = Split(Join(dict.keys))
    
    With ActiveSheet
        If .FilterMode Then .ShowAllData
        .Range("A1:H" & lastRow).AutoFilter Field:=2, Criteria1:=arrCrit, Operator:=xlFilterValues
    End With
    
End Sub

M.

Hi Marcelo,

I finally got around to try your cleaner code. It gives me an error of run-time error 13 Type Mismatch at line

.Range("A1:H" & lastRow).AutoFilter Field:=2, Criteria1:=arrCrit, Operator:=xlFilterValues

Why would that be?

 

[Marcelo Branco]

Worked perfectly for me with data sample in post 5, that is:
Data in A1:H419
Column A has just the header in A1 (Registration Plate) and blank cells in A2,A3....A419

Don't know why is not working for you.

M.

 

[asad]

Anyway, I will stick to my other code that you fixed. .
It is working fine, it's just that I wanted to use your cleaner code so that I could use it for other services as well.

Thanks for your help.

Asad

 

[Marcelo Branco]

You are welcome. Glad to help.

M.

 

[asad]

Hi Marcelo,

Another question regarding same macro if I may please.

After using the macro for few days now, I then changed my other macros to do the same. But when I tried to allocate those new macros to the buttons on sheets, I get the message "Reference must be to a macro sheet". Why is this happening?

 

[asad]

Don't worry Marcelo. I think I got it. I have named the macros with 2 at the end. I will rename the macro and try again.

 

[Marcelo Branco]

Take a look at
https://contexturesblog.com/archives/2011/10/24/excel-macro-name-conflicts/

M.

 

[asad]

Hi Again,
I am back with another issue with same code. Now there are scenarios where the vehicle will miss the one location that I am looking for in code, but it still is going to another few locations on same run. How can I incorporate looking for more than one location within the same code. So, in the code below, I would like to add for example NOV and CAR along with AVA. How would I do that?

Sub Avalon2()Dim oRange As Range


Dim dict As Dictionary
Dim vArray As Variant
Dim vItem As Variant
Dim sKey As String
Dim sValue As String
Dim iCompare_TRUE As Integer


Dim lCnt As Long
Dim lCnt_Rows As Long


With ActiveSheet
Dim rwnm As Long
    
On Error Resume Next
ActiveSheet.ShowAllData


rwnm = Range("A" & Rows.Count).End(xlUp).Row


Set dict = New Dictionary


Set oRange = ActiveSheet.Range("A1:H" & rwnm)


For lCnt = 1 To oRange.Rows.Count
    sKey = oRange(lCnt, 2)
    sValue = oRange(lCnt, 8)
    iCompare_TRUE = StrComp(sValue, "AVA")
    If Not dict.exists(sKey) And iCompare_TRUE = 0 Then
        With dict
            .Add sKey, sValue
        End With
    End If
Next lCnt


ReDim vArray(1 To dict.Count)
vArray = dict.Keys
    ActiveSheet.Range("A1:H" & rwnm).AutoFilter Field:=8, Criteria1:=Array( _
        "AVA", "SXS", "NOV", CAR", "TDep"), Operator:= _
        xlFilterValues
    ActiveSheet.Range("A1:H" & rwnm).AutoFilter Field:=2, Criteria1:=vArray, Operator:=xlFilterValues
    Range("A1").Select
End With
End Sub

Thanks
Asad

 

[asad]

No suggestions so far!

 

[asad]

Still waiting for someone to give me a suggestion for my query from 21st of August
Any help would be much appreciated