vradhak7
12-19-2015, 12:11 AM
Hello Experts.
I have attached a spreadsheet explaining what I am looking for.
To summarize, I have different worksheets which consists on company information and their rate based on weights.
I am looking to build a report page, in which I need two drop downs.The first drop down to choose the company and the second will automatically populate based on the first drop down and get the corresponding data and everytime I choose the value in dropdown, it should change automatically. Your expertise in this regard would be greatly appreciated.
Regards
Vradhak7
Bob Phillips
12-19-2015, 07:55 AM
Slightly different approach, I consolidate all of the tables, and build a pivot with slicers
Public Sub BuildReport()
Dim ws As Worksheet
Dim shResults As Worksheet
Dim shList As Worksheet
Dim shPivot As Worksheet
Dim shCon As Worksheet
Dim pvtName As String, tblName As String
Dim lastrow As Long
Dim idxRow As Long, idxCol As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ActiveWorkbook
On Error Resume Next
.Worksheets("Results").Delete
.Worksheets("List").Delete
On Error GoTo 0
Set shList = .Worksheets.Add(after:=.Worksheets(.Worksheets.Count))
shList.Name = "List"
shList.Range("A1:D1").Value = Array("Company", "Weight", "Zone", "Value")
For Each ws In .Worksheets
If ws.Name <> "List" Then
pvtName = UnpivotData(ws, shPivot)
With shPivot
.PivotTableWizard TableDestination:=.Cells(3, 1)
.PivotTables(pvtName).DataPivotField.PivotItems("Sum of Value").Position = 1
idxCol = Application.Match("Grand Total", .Rows(4), 0)
idxRow = Application.Match("Grand Total", .Columns(1), 0)
.Cells(idxRow, idxCol).ShowDetail = True
Set shCon = ActiveSheet
End With
With shCon
tblName = Replace(pvtName, "pvt", "tbl")
.ListObjects(1).Name = tblName
.Columns("A").Insert
.Range("A1").Value = "Company"
.Range("A2").Resize(.ListObjects(tblName).DataBodyRange.Rows.Count).Value = ws.Name
.ListObjects(tblName).Resize .Range("A1:D1").Resize(.ListObjects(tblName).DataBodyRange.Rows.Count)
.ListObjects(tblName).DataBodyRange.Copy
End With
With shList
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(lastrow + 1, "A").PasteSpecial Paste:=xlPasteValues
End With
shPivot.Delete
shCon.Delete
End If
Next ws
Set shResults = .Worksheets.Add(.Worksheets(.Worksheets.Count))
shResults.Name = "Results"
Call CreatePivotTable(dataSource:=shList.UsedRange, _
PivotSheet:=shResults, _
PivotTableName:="pvtResults")
With shResults
With .PivotTables("pvtResults")
With .PivotFields("Weight")
.Orientation = xlRowField
.Position = 1
End With
.AddDataField .PivotFields("Value"), "Sum of Value", xlSum
End With
Call AddSlicers(PivotSheet:=shResults, _
Pivot:=.PivotTables("pvtResults"), _
SlicerField:="Company", _
pos:=Array(20, 200, 150, 200))
Call AddSlicers(PivotSheet:=shResults, _
Pivot:=.PivotTables("pvtResults"), _
SlicerField:="Zone", _
pos:=Array(20, 400, 150, 200))
End With
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Function UnpivotData( _
ByRef sh As Worksheet, _
ByRef shPivot As Worksheet) As String
Dim rng As String
Dim pvt As String
Dim firstrow As Long
Dim lastrow As Long
Dim lastcol As Long
With ActiveWorkbook
firstrow = sh.UsedRange.Cells(1, 1).Row
lastrow = sh.UsedRange.Cells(1, 1).End(xlDown).Row
lastcol = sh.UsedRange.Cells(1, 1).End(xlToRight).Column
rng = "'" & sh.Name & "'!" & "R" & firstrow & "C1:R" & lastrow & "C" & lastcol
pvt = Replace(sh.Name, " ", "_")
.PivotCaches.Create(SourceType:=xlConsolidation, _
SourceData:=rng, _
Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:="", _
TableName:=pvt, _
DefaultVersion:=xlPivotTableVersion12
Set shPivot = ActiveSheet
UnpivotData = pvt
End With
End Function
Public Function CreatePivotTable( _
ByVal dataSource As Range, _
ByVal PivotSheet As Worksheet, _
ByVal PivotTableName As String, _
Optional ByVal cellStart As String = "A1")
Dim ws As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim pvtStartCell As String
Dim pvtSourceData As String
With ActiveWorkbook
pvtSourceData = dataSource.Address(False, False, xlR1C1, True)
pvtStartCell = PivotSheet.Range(cellStart).Address(False, False, xlR1C1, True)
Set pvtCache = .PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=pvtSourceData)
Set pvt = pvtCache.CreatePivotTable(TableDestination:=pvtStartCell, _
TableName:=PivotTableName)
End With
End Function
Private Function AddSlicers( _
ByRef PivotSheet As Worksheet, _
ByRef Pivot As PivotTable, _
ByVal SlicerField As String, _
ByVal pos As Variant)
Dim cache As SlicerCache
With ActiveWorkbook
Set cache = .SlicerCaches.Add(Pivot, SlicerField)
cache.Slicers.Add PivotSheet, , SlicerField, SlicerField, _
pos(0), pos(1), pos(2), pos(3)
End With
End Function
vradhak7
12-19-2015, 01:13 PM
HI Xld! Have you attached a file to your reply?
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.