Filtrar segun los datos de la columna

chernan5 · el 22 de agosto

Hola que tal compañeros, bien lo que necesito hacer es una macro que cada vez que se ejecute filtre segun el dato principal de una columna, por ejemplo tengo una columna que se llama clase, esa columna divide todos los datos en clases, ya sea en 10, 20 o cualquier cantidad de clases, hacer aqui una macro que filtre de uno por uno no se me hizo tan complicado ya que las clases avanzan de uno en uno, pero por ejemplo si tengo otra columna con datos diferentes y no corridos, como le hago para caturar los datos que contiene esa columna y asi cada vez que ejecute la macro se vaya filtrando el siguiente valor.

se que se escucha muy confuso asi que pondre el codigo de lo que les comento de las clases, esta macro va filtrando de valor en valor cada vez que se ejecuta:

Public rng, val, fin, Lcol, paq1 As Integer
Sub ClassChangeNext()
'
' ClassOrganizer Macro
'
' Keyboard Shortcut: Ctrl+Shift+L
'
    Dim classNo, valorbuscado As String
    Dim res As Range
    cond = "class"
    val = 1
    
    'Esta linea es solo para identificar la ultima columna con datos
    Lcol = Range("XFD1").End(xlToLeft).Cells.Row
    
    'Aqui busca la columna que contiene el valor class
    Set res = Range("A1:XFD1").Find(cond, , xlValues, xlWhole, xlByColumns, xlNext, False, , False)
    
    If res Is Nothing Then
        MsgBox "No se encontraro la columna class!"
    Else
    ' esta linea hace el match con la columna class y la guarda en una variable para despues hacer el filtro
    paq1 = Evaluate("match(""class"",1:1,0)")

    Call check
    Call ContadorClass
    
    'esta variable guarda el valor de la clase que se va a filtrar
    classNo = rng

    'y aqui se filtra el valor de la clase
    ActiveSheet.Range("A1" & Lcol).AutoFilter Field:=paq1, Criteria1:=classNo
    
    'returns variables to 0 when it's over
    If rng > fin Then
        rng = 0
        fin = 0
        ActiveSheet.Range("A1" & Lcol).AutoFilter Field:=paq1
        MsgBox "Se terminaron las clases"
    End If
    
    End If
    
End Sub

Private Sub ContadorClass()
'Update
'este sub, checa el numero de la clase en la que va, si es 0 le asigna un uno y asi se filtra la primera clase
    If rng = 0 Then
        rng = val
    Else
        rng = rng + 1

    End If

End Sub

Private Sub check()
    'Este sub checa cual es el ultimo numero de clase, para asi poder detener la macro cuando se hayan terminado las clases que existen
    'Si la variable ya esta inicializada se salta al siguiente paso
    If fin = 0 Then
        ending = Range("B" & ActiveSheet.Rows.CountLarge).End(xlUp).Cells.Row
        fin = Range("B" & ending).value
    End If
    
End Sub

Como ven pues aqui con esta macro, cada vez que la ejecutas se filtra por el numero de clase, primero 1, la ejecutas y luego el 2, y luego 3 y asi sucesivamente, a mi lo que me gustaria es, en caso de que no sean los numeros continuos como le haria?, porque si lo dejo asi y el numero no se encuentra en la columna digamos un 5 pero si se encuentra un 6, en el 5 se filtra nada y eso podria ser confuso para el usuario, entonces me gustaria saber si hay alguna manera de evaluar los valores de la columna y asi saber por cual numero debe filtrar enseguida, espero se entienda a que quiero llegar y sobre todo puedan ayudarme.

muchas gracias de antemano!

chernan5 · el 24 de agosto

Por si a alguien le sirve ya lo resolvi, en realidad no supe como capturar el valor de cada celda para asi filtrar de uno por uno, asi que lo que hice fue enumerar las descripciones de la columna que quiero filtrar automaticamente de uno por uno y de esta manera obtener numeros corridos, asi quedo, primero se ejecuta esta macro y luego ya la que habia puesto anteriormente, claro que cambiando solo algunos parametros de la otra(Match):

Sub PrepLinesXveh()

	cond = "linesXveh"


    'Find the column LinesxVeh
    Set res = Range("A1:XFD1").Find(cond, , xlValues, xlWhole, xlByColumns, xlNext, False, , False)
    
    If res Is Nothing Then
        MsgBox "No se encontro la columna linesXveh!"
    Else
    
    Ens = Range("H" & ActiveSheet.Rows.CountLarge).End(xlUp).Cells.Row
    ActiveWorkbook.Worksheets("detail").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("detail").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("H1" & Ens), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
        With ActiveWorkbook.Worksheets("detail").AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
    Columns("H:H").Select
    Selection.Copy

    Sheets.Add(After:=Worksheets("detail")).Name = "val"
    Range("A1").Select
    ActiveSheet.Paste

    LR = Range("A" & ActiveSheet.Rows.CountLarge).End(xlUp).Cells.Row
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=IF(COUNTIF(R2C1:RC[-1],RC[-1])=1,1,0)"
    Selection.AutoFill Destination:=Range("B" & LR, "B2")
    Range("B" & LR, "B2").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    'LRc = Range("C" & ActiveSheet.Rows.CountLarge).End(xlUp).Cells.Row
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=SUMPRODUCT(R2C2:RC[-1]:R2C2:RC[-1])"
    Selection.AutoFill Destination:=Range("C" & LR, "C2")
    Range("C" & LR, "C2").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("C:C").Select
    Range("C2").Activate
    Application.CutCopyMode = False
    Selection.Copy
    ActiveSheet.Previous.Select
    
    Selection.Insert Shift:=xlToRight
    Range("H1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "NLinesXVeh"
    Columns("H:H").ColumnWidth = 3.29

    Application.Goto Reference:="R1C1"
    
    Application.DisplayAlerts = False
    Sheets("val").Select
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    
    End If
    
    
End Sub

Espero que a alguien le sea de ayuda