Pivot Tables or VB Script. Aggregate totals, detail records

JohnB01012001

New Member
Joined
Jul 27, 2007
Messages
1
I need help to generate a report and I'm hoping there's someone out here who can spare a moment. I'm not sure how to do this.
(Sorry, I'm on a managed machine and cannot download any software from the web site).

Column 1 is a list of programs.
Row 1...Col 1: Value "Prog A"
Row 2...Col 1: Value "Prog B"
Row 3...Col 1: Value "Prog C"
Row 4...Col 1: Value "Prog D"

Columns 2 - 4 are a list of systems (Same spreadsheet tab).
Row 1...Col 2: Val: "Sys 1"....Col 3: Val "Sys 2"....Col 4: Val "Sys 3"
Row 2...Col 2: Val: "Sys 5"....Col 3: Val "Sys 2"....Col 4: Val ""
Row 3...Col 2: Val: "Sys 1"....Col 3: Val "Sys 3"....Col 4: Val ""
Row 4...Col 2: Val: "Sys 3"....Col 3: Val "Sys 4"....Col 4: Val "Sys 5"

I need a report that lists programs by system:
System Name. Program
Sys 1............. Prog A
..................... Prog C
Sys 2............. Prog A
..................... Prog B
Sys 3............. Prog A
..................... Prog C
..................... Prog D
Sys 4............. Prog D
Sys 5............. Prog B
..................... Prog D

Programmers can key in any program name or system name value they want in the spreadsheet. I don't know what values they'll key.
This report needs to list each system name only once, with the ability to report on as many programs they've entered.

I'll need to do some additional lookups from other tabs in the same spreadsheet. But I'd thought I'd try to crawl before I walk.

Thank !!! :biggrin:

P.S. I don't know any VB or Access.
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
I suppose this might be a quick and dirty but...

Code:
Sub ProgramsBySystems()
Dim r As Variant
Dim wsSource As Worksheet, wsCopy As Worksheet
Dim myWorkbook As Workbook
Dim lCol As Long, lRow As Long, x As Long, zRow As Long

'Add workbook for data collection
Set wsSource = ActiveSheet
Workbooks.Add
Set myWorkbook = ActiveWorkbook
wsSource.Activate


'Use input box method to select area to process
On Error GoTo Handler
Set r = Application.InputBox("Select Data Area Without Column Headers", Type:=8)
On Error GoTo 0

'Copy data to new workbook
r.Copy Destination:=myWorkbook.Worksheets(1).Range("A1")

'Determine rows and columns to process
myWorkbook.Activate
Worksheets(1).Activate
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
lRow = Cells(Rows.Count, 1).End(xlUp).Row

'Process columns to create a normalized database grid
'The grid will have 2 columns, Programs in col.1 and Systems in col.2
For x = 3 To lCol
    zRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Range(Cells(1, 1), Cells(lRow, 1)).Copy Destination:=Cells(zRow, 1)
    Range(Cells(1, x), Cells(lRow, x)).Copy Destination:=Cells(zRow, 2)
Next x

'delete columns that were copied
Range(Cells(1, 3), Cells(Rows.Count, lCol)).Clear

'Add headers
Rows("1:1").Insert Shift:=xlDown
Range("A1").Value = "Programs"
Range("B1").Value = "Systems"

Handler:
End

End Sub

Sub HideTotalRowsInPivotTable()
Dim lRow As Long, x As Long

lRow = Cells(Rows.Count, 1).End(xlUp).Row

For x = lRow To 1 Step -1
    If Right(Cells(x, 1), 5) = "Total" Then
        Cells(x, 1).EntireRow.Hidden = True
    End If
Next x

End Sub

What this routine does is reformat your data so that it is useable for a pivot table....All the programs in column A and all the systems in column B. With this new data grid you can build a simple pivot table with Programs and Systems both as row fields. I've provided a macro to hide the subtotals (You can also do this by click the subtotals and selecting hide from the menu...but I've not figured out how to get these back -unhide- so this option is one I don't use much). All of this happens in a separate workbook so you will not have any changes to your original data.

Doubtless there are other approaches so this is only one try. If anyone has suggestions for improvement let me know. One issue I encountered was a problem if cancel is clicked during the input box statement....False is returned and then the line errors out because it is a Set statement for an object (r). I just created a simple handler to error out more gracefully.

-------------------------------
To run this code:
Click the Sheet tab,
Select View Code to open the Visual Basic Editor window,
Paste the code.

Or:
Click the Sheet tab,
Select View Code to open the Visual Basic Editor window,
From the VBE Menu: Insert >> Module (not a class module)
Paste the code.

This gives you the option of keeping this macro in another workbook. In either case, the macro will work in any workbook...the workbook simply must be open when you want to run the code (Tools | Macro | Macros... and select the macro name from the list ... you just need to be sure you are looking at macros in all open workbooks). When you run the macro, however, the sheet with your systems and programs must be the current (active) sheet.
 
Upvote 0

Forum statistics

Threads
1,214,915
Messages
6,122,214
Members
449,074
Latest member
cancansova

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top