Crear una macro para ocultar Columnas vacias

[Ppep]

Hola, 

Quisiera saber de una macro para ocultar columnas vacías, de una tabla cuando aplico un filtro (o varios), y me quite también las que están ocultas que tienen datos pero no salen en el filtro. 

 

 

Un saludo. 

rMezclaCompletamacro25.xlsm

[Israel Cassales]

Varios meses después...

Hola,

Viendo los temas de las consultas sin responder, considerando el tiempo y las descargas que han pasado en este lapso cabe mencionar que no es común la falta de participaciones. De mi parte le soy sincero, me costo entender como se desencadenan los eventos y cómo serían los pasos. Es posible que a la fecha reciente ya haya usted encontrado la solución a su consulta, así que participaré con lo que se trato de explicar en su descripción; esperando sea de utilidad para futuros lectores.

Le comparto tres códigos similares, el primero solo oculta de la tabla las columnas sin datos dentro de la misma, el segundo oculta las columnas que no tienen datos visibles, y el tercero oculta y muestra datos visibles dentro de ese rango.

Sub OcultarColumnasSinDatos()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim col As ListColumn
    Dim celda As Range
    Dim tieneDatos As Boolean
    
    Set ws = ThisWorkbook.Sheets("Mezcla 2")
    Set tbl = ws.ListObjects("Tabla1")
    
    For Each col In tbl.ListColumns
        tieneDatos = False
        
        For Each celda In col.DataBodyRange
            If Not IsEmpty(celda.Value) Then
                tieneDatos = True
                Exit For
            End If
        Next celda
        
        If Not tieneDatos Then
            col.Range.EntireColumn.Hidden = True
        Else
            col.Range.EntireColumn.Hidden = False
        End If
    Next col
End Sub

Sub OcultarColumnasSinDatos_2()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim rng As Range
    Dim col As ListColumn
    Dim cell As Range
    Dim colHidden As Boolean
    
    Set ws = ThisWorkbook.Sheets("Mezcla 2")
    Set tbl = ws.ListObjects("Tabla1")
    
    For Each col In tbl.ListColumns
        colHidden = True
        For Each cell In col.DataBodyRange.SpecialCells(xlCellTypeVisible)
            If Not IsEmpty(cell.Value) Then
                colHidden = False
                Exit For
            End If
        Next cell
        col.Range.EntireColumn.Hidden = colHidden
    Next col
End Sub

Sub OcultarColumnasSinDatos_3()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim rng As Range
    Dim col As ListColumn
    Dim cell As Range
    Dim colHidden As Boolean
    Dim filterActive As Boolean
    Dim i As Integer
 
    Set ws = ThisWorkbook.Sheets("Mezcla 2")
    Set tbl = ws.ListObjects("Tabla1")
    
    filterActive = False
    For i = 1 To tbl.Range.Columns.Count
        If tbl.AutoFilter.Filters(i).On Then
            filterActive = True
            Exit For
        End If
    Next i
    
    If Not filterActive Then
        tbl.Range.EntireColumn.Hidden = False
        Exit Sub
    End If
    
    For Each col In tbl.ListColumns
        colHidden = True
        For Each cell In col.DataBodyRange.SpecialCells(xlCellTypeVisible)
            If Not IsEmpty(cell.Value) Then
                colHidden = False
                Exit For
            End If
        Next cell
        col.Range.EntireColumn.Hidden = colHidden
    Next col
End Sub

Por otro lado es posible que desee usar el filtro como un detonante, entonces aunque hay consideraciones que especificar, en general debería ser útil desencadenar con el cambio en la tabla en su hoja activa.

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

Es cuestión de que se hagan pruebas.

Saludines

[Israel Cassales]

rMezclaCompletamacro25 - AYUDA EXCEL.xlsb