using VBA to hide rows in a pivot table

[gayjaybird]

Sub Hidesingles()
  For i = 5 To ActiveSheet.UsedRange.Rows.Count
      For c = 3 To ActiveSheet.UsedRange.Column.Count
        If Cells(i, c) <= 1 Then Cells(i, 1).EntireRow.Hidden = True Else: Next c
        End If
Next i
End Sub

I'm trying to filter a pivot table with VBA. The spreadsheet/database I'm summarizing has fields for the store name, the package tracking number, the date and the sender's store name. Row headings are store name and tracking number, and the columns are the date. The pivot table counts how many times a particular sender's store name shows up on a particular date. I have the rows collapsed so that the table only displays the subtotals for each store for each day. How can I filter the table so that only the stores who sent more than one package a day are listed? I tried the code above and ended up with a 'Next without For error.' Any ideas?

 

[xenou]

The issue with the message about arrays is one that I have seen before but cannot reproduce right now...I've forgotten what triggers this message exactly. I am able to copy and paste the filtered data without any difficulties. This post will show an alternate method to select and paste the data - it involves adding a button to your standard toolbar. The button will Select visible cells, which you then can copy with Ctrl + C (copy the selected cells), and then paste. You might want to go to OfficeUpdate and check that your version of Office is fully up to date - the reason I say this is that I used to get this problem too and now it just doesn't happen anymore, so maybe there was a fix in the last office update pack (service pack 2 .... now we are up to service pack 3). You click on the check for updates to see if you are up to date.

http://www.mrexcel.com/board2/viewtopic.php?p=1380956#1380956

http://office.microsoft.com/en-us/downloads/default.aspx

EDIT: Note, I am posting another code revision below....

 

[xenou]

This is a revision to the subroutine called NewSheetWithSubtotals. You can just paste this in in place over the old routine. I find subtotals ugly and messy so I tried a coded solution to create the subtotals. This happens to work on the sheet without the extra columns added in (the second new book). It also "adds" up the stores at one less than the real sum...which might be nice as it is your excess. Perhaps you could change the label from "Total: " to "Excess Shipments: ". To get real totals inclusive of the first shipment, change the two statements that say myCount = 0 to myCount = 1

See how it works...maybe you needed it on the other sheet? I would also be happy to try coding this in as a subtotal after all if you would prefer...I think we can get it to work too.

'----------------------------------------------
Private Sub NewSheetWithSubtotals(Arg1 As Worksheet)
'REVISION 10/16/2007

Dim x As Long
Dim i As Long
Dim myCount As Long

Const IN_A_NEW_WORKBOOK As Boolean = True
    'Set the above constant equal to false if you want a second subtotals sheet
        'in the same workbook instead of in a new workbook

Arg1.Activate

If IN_A_NEW_WORKBOOK Then
    Arg1.Copy
    Activesheet.Name = "ForSubtotals"
Else
    Arg1.Copy After:=Arg1
    Activesheet.Name = "ForSubtotals"
End If

'Since we are working off the sheet with the columns added, take them back out
For x = Cells(ROW_WITH_HEADERS, Columns.Count).End(xlToLeft).Column To 1 Step -1
    If WorksheetFunction.CountA(Columns(x)) = 1 Then
        Columns(x).Delete
    End If
Next x

'Sort by Sender company
Cells(ROW_WITH_HEADERS, COLUMN_SENDER_COMPANY_NAME).CurrentRegion.Sort _
    Key1:=Cells(ROW_WITH_HEADERS, COLUMN_SENDER_COMPANY_NAME), Order1:=xlAscending, Header:=xlGuess


i = ROW_WITH_HEADERS + 1
myCount = 0
Do While Not IsEmpty(Cells(i, COLUMN_SENDER_COMPANY_NAME).Value)
    
    'Get store cells
    Do While Cells(i, COLUMN_SENDER_COMPANY_NAME).Value = _
        Cells(i + 1, COLUMN_SENDER_COMPANY_NAME).Value
        i = i + 1
        myCount = myCount + 1
    Loop
    
    'Insert two rows and a total
    Cells(i + 1, COLUMN_SENDER_COMPANY_NAME).EntireRow.Insert Shift:=xlDown
    Cells(i + 1, COLUMN_SENDER_COMPANY_NAME).EntireRow.Insert Shift:=xlDown
    Cells(i + 1, COLUMN_SENDER_COMPANY_NAME).Value = "Total: " & myCount
    myCount = 0
    i = i + 3

Loop


End Sub

 

[gayjaybird]

Something stupid I probably should have mentioned before: My end user is using Excel 2003. I didn't think that would be a problem, but when I attempted to send the code to her so she could paste it into her VBA editor, she got sytax errors in various places. Are there commands in the code that aren't 2003 compatible, or are there formatting issues that are causing problems?

 

[xenou]

That should not be a problem. You might want to just try again. The code is written on Excel 2003, in fact. I don't think anything written here would not work on either Excel 2003 or 2007 - I am not so certain about backward compatibility.

If you still have errors post the specific lines that are causing problems.

Regards.