Autosum at an empty cell in column. Only autosum for visible cells!

[Madter]

Hi guys.
I have a data sheet which is attached here.
I get a new data sheet like this every day, and that is why i need it to autosum where the red arrows are pointing in the attached picture.
I've used filter so i only need it for the visible cells.

I have this macro;

Sub AutoSum()
Dim Area As Range, MyColumn As String
MyColumn = "A"
    For Each Area In Columns(MyColumn).SpecialCells(xlConstants, xlNumbers).Areas
        SumAddr = Area.Address(False, False)
        Area.Offset(Area.Count, 0).Resize(1, 1).Formula = "=SUM(" & SumAddr & ")"
    Next Area
End Sub

..where i've tried substituting "xlConstants" with xlCellTypeVisible and deleting xlNumbers, but i can't seem to get it to work.
Any suggestions?

https://www.screencast.com/t/jwSSZNW1Us
Thanks

 

[RoryA]

If you want the code to work on column H, your code should surely read:

MyColumn = "H"

and not:

MyColumn = "A"

 

[Madter]

If you want the code to work on column H, your code should surely read:

MyColumn = "H"

and not:

MyColumn = "A"

I Know, that's not the issue. The issue is that the autosum sums all Numbers from the empty Cell and upwards instead of taking the visible cells only

 

[JackDanIce]

Try:

Sub AutoSum()

    Dim x       As Long
    Dim LR      As Long
    Dim start   As Long
    
    Application.ScreenUpdating = False
    
    With ActiveSheet
        If .AutoFilterMode Then .AutoFilter = False
        LR = .Cells(.Rows.count, 1).End(xlUp).row
        start = 2
        For x = 2 To LR
            If Len(.Cells(x + 1, 1)) = 0 And start < x Then
                adj = 1
                If Abs(x - start) = 1 Then adj = 0
                .Cells(x + adj, 8).Value = Application.SumIf(.Cells(start, 1).Resize(x), "N", .Cells(start, 8).Resize(x - start + 1))
                start = x + 2 + adj
            End If
        Next x
    End With
    
    Application.ScreenUpdating = True
    
End Sub

 

[RoryA]

You should use SUBTOTAL rather than SUM then:

.Formula = "=SUBTOTAL(109," & SumAddr & ")"

 

[Madter]

Try:

Sub AutoSum()

    Dim x       As Long
    Dim LR      As Long
    Dim start   As Long
    
    Application.ScreenUpdating = False
    
    With ActiveSheet
        If .AutoFilterMode Then .AutoFilter = False
        LR = .Cells(.Rows.count, 1).End(xlUp).row
        start = 2
        For x = 2 To LR
            If Len(.Cells(x + 1, 1)) = 0 And start < x Then
                adj = 1
                If Abs(x - start) = 1 Then adj = 0
                .Cells(x + adj, 8).Value = Application.SumIf(.Cells(start, 1).Resize(x), "N", .Cells(start, 8).Resize(x - start + 1))
                start = x + 2 + adj
            End If
        Next x
    End With
    
    Application.ScreenUpdating = True
    
End Sub

It gives me a run-time error "'438': Object doesn't suport this property or method" on the .Autofilter=False.
What to do?

 

[JackDanIce]

Change to .Autofiltermode = False

No need to re-quote the entire previous reply back, it's still visible on the thread and readable. Quoting the entire reply just makes this thread longer and more to scroll through. Unless you have a different perspective?

 

[Madter]

No, you're right

And we are almost there! But now it just deletes the filters, and almost leaves the sheet as it was before the filters, with the exception of the sum of the column we wanted. :/

 

[JackDanIce]

Try:

Sub AutoSum()


    Dim x       As Long
    Dim LR      As Long
    Dim start   As Long
    
    Application.ScreenUpdating = False
    
    With ActiveSheet
        If .AutoFilterMode Then .AutoFilterMode = False
        LR = .Cells(.Rows.count, 1).End(xlUp).row
        start = 2
        For x = 2 To LR
            If Len(.Cells(x + 1, 1)) = 0 And start < x Then
                adj = 1
                If Abs(x - start) = 1 Then adj = 0
                .Cells(x + adj, 8).Value = Application.SumIf(.Cells(start, 1).Resize(x), "N", .Cells(start, 8).Resize(x - start + 1))
                start = x + 2 + adj
            End If
        Next x
        With .Cells(1, 1).Resize(LR, 10)
            .AutoFilter
            .AutoFilter Field:=8, Criteria1:="<>"
            .AutoFilter Field:=1, Criteria1:="N"
        End With
    End With
    
    Application.ScreenUpdating = True
    
End Su

 

[Madter]

But it doesn't have to be connected with the filters in column "A". The only thing that is important, is that after filtering the sheet, i need the sum at the empy cells of column H

 

[Madter]

Now it just deletes the empty rows in the middle