VBA to skip hidden cells without cicle

Question

I've wrote a macro in an add-in that update the status-bar when you select a range: This macro (included in "thisWorkbook" of the add-in with a SheetSelectionChange) write on status-bar the matrix sum product of the first and last column in selection. It works very good but if there's a active filter I'd like it skip the hidden cells. this is the code.

Private WithEvents App As Application

Private Sub App_SheetselectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim vStatus As Variant
    Dim nCols As Long
    Dim prod_vett As Variant
    On Error GoTo err_gest_
    With Target
      nCols = .Columns.Count
      If nCols > 1 Then
        prod_vett = Application.Evaluate("sum(" & .Columns(1).Address & "*" & .Columns(nCols).Address & ")")
        vStatus = "Prodotto vettoriale: " & prod_vett
      End If
    End With
    err_gest_:
      If Err.Number <> 0 Then vStatus = False
      Application.StatusBar = vStatus
    End Sub

Private Sub Workbook_Open()
    Application.StatusBar = False
    Set App = Application   'Instantiate application level events

End Sub

If I use a cicle there is a problem: if a select all cells in worksheet the macro is too much long to give me a result. I try to use

With Target.SpecialCells(xlCellTypeVisible)

But it doesn't work. Have you got other solution?

score 0 · Answer 1 · edited Jul 02 '15 at 05:34

Try this:

Private WithEvents App As Application

Private Sub App_SheetselectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim vStatus As Variant
    Dim prod_vett As Variant
    '----------------------------
    Dim rng As Excel.Range
    Dim area As Excel.Range
    Dim data As Variant
    Dim row As Long
    Dim firstCol As Integer
    Dim lastCol As Integer
    '----------------------------

    On Error GoTo err_gest_

    Set rng = Target.SpecialCells(xlCellTypeVisible)

    For Each area In rng.Areas
        data = area
        firstCol = LBound(data, 2)
        lastCol = UBound(data, 2)

        For row = LBound(data, 1) To UBound(data, 1)
            prod_vett = prod_vett + data(row, firstCol) * data(row, lastCol)
        Next row

    Next area

    vStatus = "Prodotto vettoriale: " & prod_vett

err_gest_:
      If Err.Number <> 0 Then vStatus = False
      Application.StatusBar = vStatus

End Sub

Private Sub Workbook_Open()
    Application.StatusBar = False
    Set App = Application
End Sub

score 0 · Answer 2 · answered Jul 02 '15 at 07:10

it seems that doesn't work. but when i tried to go step by step i observed that it works but when arrive at " End Sub" line come back to for each area in rng.Areas and the Err.Number became <> 0 and so the vStatus variable beacme false and the statu bar doesn't update. I resolved with this change:

Private Sub App_SheetselectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim vStatus As Variant
    Dim prod_vett As Variant
    '----------------------------
    Dim rng As Excel.Range
    Dim area As Excel.Range
    Dim data As Variant
    Dim row As Long
    Dim firstCol As Integer
    Dim lastCol As Integer
    '----------------------------

    On Error GoTo err_gest_

    Set rng = Target.SpecialCells(xlCellTypeVisible)

    For Each area In rng.Areas
        data = area
        firstCol = LBound(data, 2)
        lastCol = UBound(data, 2)

            For row = LBound(data, 1) To UBound(data, 1)
                prod_vett = prod_vett + data(row, firstCol) * data(row, lastCol)
            Next row

    Next area
    If prod_vett <> 0 Then
        vStatus = "Prodotto vettoriale: " & prod_vett
            Else: vStatus = False
    End If
    Application.StatusBar = vStatus
    Exit Sub

err_gest_:
vStatus = False
Application.StatusBar = vStatus
End Sub

However i can't understand why at End Sub it doesn't exit from macro and start again...

VBA to skip hidden cells without cicle

2 Answers2