Adding up filtered list..........only what is shown on screen?.....

D

Duncan

Hi all, (again!)

I am trying to get the totals of a filtered range, the below (which i
have painstakingly put together with the help of F8) will loop through
the G collumn and keep adding to my textbox until it reaches an empty
cell, The drawback that I am trying to work out is that regardless of
the fact that the screen is showing a filtered list, it carries on
adding the ones not shown on the screen.

The line below which says "If xlCellTypeVisible = False Then" does not
do anything at all, Does anyone know how I can only add the cells that
are shown on screen?

(come to think of it now, I think the first offset should offset to the
next cell shown on screen instead of G2......I forgot that what im
testing with does have an entry on row 2 but if it didnt then that
would be a problem....ooops)

Set rng1 = Range("g1").Offset(1, 0)
rng1.Activate
LOPRtot.Value = ActiveCell.Value
If rng1.Offset(1, 0).Value >= 1 Then
rng1.Offset(1, 0).Activate
LOPRtot.Value = LOPRtot.Value + ActiveCell.Value
ActiveCell.Offset(1, 0).Activate
End If

Do

If ActiveCell.Value >= "" Then
If xlCellTypeVisible = False Then
LOPRtot.Value = LOPRtot.Value + ActiveCell.Value
ActiveCell.Offset(1, 0).Activate
Else
Exit Sub
End If
End If
Loop Until ActiveCell.Value = ""
 
A

Ardus Petus

Use: If ActiveCell.Hidden = True Then
instead of: If xlCellTypeVisible = False Then

HTH
 
G

Guest

Duncan,
Me again. It appears a simple loop through the range
will suffice.

This added the visible rows following the filter:

s=0
For i = 3 To 32
If Rows(i).Hidden = False Then s = s + Cells(i, "G")
Next i
 
D

Duncan

Ok, Ive tried that now Ardus but im getting "unable to get the hidden
property of the range class" which confuses me....any ideas?

my code as I have been banging away at it now for ages looks quite
differant, ill post it below.

Duncan


Set rng1 = Range("g1").Offset(0, 0)

rng1.Activate
Do
ActiveCell.Offset(1, 0).Activate
If ActiveCell.Hidden = True Then
Exit Sub
Else
If ActiveCell.Value = "" Then
Exit Sub
Else
LOPRtot.Value = LOPRtot.Value + ActiveCell.Value
End If
End If

Loop Until ActiveCell.Value = ""
 
G

Guest

Duncan,
As I discovered, HIDDEN can only be applied to ROWS or
COLUMNS not cells! See my other post.
 
D

Duncan

Wow,

now i dont have a clue what this is doing,, but i think its
working....it might have missed a row because it gave me "21" and i
expected "23" so it might have missed a row with "2" on....

was i right to put "LOPRtot.Value = s" just underneath that loop to
catch the amount? appears to have put the value in the textbox....

Many thanks anyway.....if i can work out what it means and what its
doing then it looks like a much much (much) simpler way of getting the
same effect!
 
D

Duncan

nope, 10 seconds later i realise that its not missing a row but
starting from row 3 instead of row 2...? (i=3 to 32)? I changed it to
i=2 to 32 assuming that it meant the rows it would look at, and its
given me the expected answer, have i got the concept right though?
 
G

Guest

Try this:

With Worksheets("Sheet1") '<=== change as required
Lastrow = .Cells(Rows.Count, "G").End(xlUp).Row
s = 0
For i = 2 To Lastrow
If .Rows(i).Hidden = False Then s = s + .Cells(i, "G")
Next i
End With
MsgBox s
LOPRtot.value=s
 
D

Duncan

Yep, Perfect.

I will post my full sub below for the benefit of others, I just want to
incorporate the print function again like on my other sub and a few
tweaks but other than that it is perfect!.

Many thanks Toppers.
Private Sub CommandButton1_Click()

Sheets("sheet1").Select

Dim Date1 As Date, Date2 As Date
Date1 = Format(Date1t.Text, "DD/MM/yyyy")
Date2 = Format(Date2t.Text, "DD/MM/yyyy")

Range("D1").End(xlDown).Offset(1, 0).Select
ActiveCell.Select

Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:=">=" & CLng(Date1),
Operator:=xlAnd _
, Criteria2:="<=" & CLng(Date2)

LOPRdaterange.Hide

Select Case MsgBox("Print?", vbYesNo)
Case vbYes

'will put something here to print out the sheet

Sheet1.Activate

With Worksheets("Sheet1")
Lastrow = .Cells(Rows.Count, "G").End(xlUp).Row
s = 0
For i = 2 To Lastrow
If .Rows(i).Hidden = False Then s = s + .Cells(i, "G")
Next i
End With
MsgBox s
LOPRtot.Value = s

With Worksheets("Sheet1")
Lastrow2 = .Cells(Rows.Count, "H").End(xlUp).Row
s2 = 0
For j = 2 To Lastrow2
If .Rows(j).Hidden = False Then s2 = s2 + .Cells(j, "H")
Next j
End With
MsgBox s2
LOPRus.Value = s2

Selection.AutoFilter
LOPRdaterange.Show
Exit Sub

Case vbNo

'will replicate the above here so it still populates the form with
figures
Selection.AutoFilter
LOPRdaterange.Show

Exit Sub
End Select

Sheets("sheet1").Select

End Sub
 
G

Guest

A better solution would be to avoid the loops and take advantages of what
Excel offers:

With Worksheets("Sheet1")
set rng = Intersect(.Autofilter.Range,.columns(7))
s = application.Subtotal(9,rng)
msgbox s
LOPRtot.Value = s
End With


With Worksheets("Sheet1")
set rng = Intersect(.Autofilter.Range,.columns(8))
s2 = Application.Subtotal(9,rng)
msgbox s2
LOPRus.Value = s2
End With
 
G

Guest

Tom,
I looked at SUBTOTAL but I wasn't aware of the Autofilter.range
construct.

The more I know, the less I know!

Thanks ... I just hope this lodges in the old (true in my case) memory bank.
 
D

Duncan

Thanks Tom, I will re-post my code as I have also added the print
function and im not touching it anymore now as it works!!

Many thanks

Duncan

Private Sub CommandButton1_Click()

Sheets("sheet1").Select

Dim Date1 As Date, Date2 As Date
Date1 = Format(Date1t.Text, "DD/MM/yyyy")
Date2 = Format(Date2t.Text, "DD/MM/yyyy")

Range("D1").End(xlDown).Offset(1, 0).Select
ActiveCell.Select

Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:=">=" & CLng(Date1),
Operator:=xlAnd _
, Criteria2:="<=" & CLng(Date2)

LOPRdaterange.Hide

Select Case MsgBox("Print?", vbYesNo)
Case vbYes
'will put something here to print out the sheet
Sheet1.Activate
Set rng = Range("A1:I" & Range("a65536").End(xlUp).Row)
rng.Select
Selection.PrintOut Copies:=1, Collate:=True


With Worksheets("Sheet1")
Set rng = Intersect(.AutoFilter.Range, .Columns(7))
s = Application.Subtotal(9, rng)
MsgBox s
LOPRtot.Value = s
End With


With Worksheets("Sheet1")
Set rng = Intersect(.AutoFilter.Range, .Columns(8))
s2 = Application.Subtotal(9, rng)
MsgBox s2
LOPRus.Value = s2
End With

Selection.AutoFilter
LOPRdaterange.Show
Exit Sub

Case vbNo
'will replicate the above here so it still populates the form with
figures
With Worksheets("Sheet1")
Lastrow = .Cells(Rows.Count, "G").End(xlUp).Row
s = 0
For i = 2 To Lastrow
If .Rows(i).Hidden = False Then s = s + .Cells(i, "G")
Next i
End With
LOPRtot.Value = s

With Worksheets("Sheet1")
Lastrow2 = .Cells(Rows.Count, "H").End(xlUp).Row
s2 = 0
For j = 2 To Lastrow2
If .Rows(j).Hidden = False Then s2 = s2 + .Cells(j, "H")
Next j
End With
LOPRus.Value = s2

Selection.AutoFilter
LOPRdaterange.Show

Exit Sub
End Select

Sheets("sheet1").Select

End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As
Integer)
' Prevents use of the Close button
If CloseMode = vbFormControlMenu Then
MsgBox " Clicking this button will not work. " & vbCrLf
& "" & vbCrLf & " Please use the Close button provided below "
Cancel = True
End If
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Speed it up? 4
Pivot date, that's all 6
PLEASE help ... 3
Need help-For loop 3
Type mismatch error only on the first run 2
loop until empty row and column problem (format cells until the lastrow and column in a report) 2
Step to next row in a filtered sheet using form 4
Deleting cells if there is an alphabetical character in it 3

Top