Filter data using Pivot table clicks

Filter data using Pivot table clicks
10 April 2007

This macro allows you to double click on a cell in a pivot table and view the details in the data using auto-filter set in the data sheet.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rowHead As Range
Dim colHead As Range
Dim r, c, rowsBeforeStart, colsBeforeStart As Integer
Dim rowFieldOnSheet, colFieldOnSheet As Integer
Dim rowStr, colStr As String
Dim pivotSheet, dataSheet As Worksheet

Cancel = True

Set pivotSheet = Sheet2
Set dataSheet = Sheet3

' Row/Column headers
Set rowHead = pivotSheet.Range("A6:A11") 'Pivot table row header
Set colHead = pivotSheet.Range("B5:P5") 'Pivot table column header
' Offset for header row/column
rowsBeforeStart = 5
colsBeforeStart = 1
' Corresponding columns in the datasheet
rowFieldOnSheet = 8
colFieldOnSheet = 6


'This code provided filtering on Sheets based in pivot table
r = Target.row - rowsBeforeStart
c = Target.Column - colsBeforeStart

If (r <> rowHead.Rows.Count) Then
    r = -1
End If

If (c <> colHead.Columns.Count) Then
    c = -1
End If

dataSheet.Activate
dataSheet.Range("A1").Select

If (r <> -1) Then
    rowStr = rowHead.Cells(r, 1).Value
    If (rowStr = "(blank)") Then rowStr = "="
    Selection.AutoFilter Field:=rowFieldOnSheet, Criteria1:=rowStr
Else
    Selection.AutoFilter Field:=rowFieldOnSheet
End If

If (c <> -1) Then
    colStr = colHead.Cells(1, c).Value
    If (rowStr = "(blank)") Then rowStr = "="
    Selection.AutoFilter Field:=colFieldOnSheet, Criteria1:=colStr
Else
    Selection.AutoFilter Field:=colFieldOnSheet
End If
End Sub

Excel VBA guide

Tutotials:

Anthony's VBA page
Excel VBA Tutorial
Control PowerPoint from Excel

Select a range and change the cell values randomly

Sub FloatAround()
Dim selRange As Range
Dim txt As String

If Selection Is Nothing Then GoTo ErrorMsg
If TypeName(Selection) <> "Range" Then GoTo ErrorMsg
If Selection.Areas.Count > 1 Then GoTo ErrorMsg

Set selRange = Selection
selRange.NumberFormat = "0.00"
For i = 1 To selRange.Rows.Count
  For j = 1 To selRange.Rows(i).Cells.Count
      txt = CStr(selRange.Rows(i).Cells(j).Value + (Rnd / 3#))
      selRange.Rows(i).Cells(j).Value = txt
  Next j
Next i

Exit Sub
ErrorMsg:
MsgBox "Incorrect Selection", vbOKOnly + vbCritical
End Sub

Copy several charts from excel into a new power point presentation

Modified from http://www.erlandsendata.no/english/index.php?d=envbaolecontrolpowerpoint

Sub CreateNewPowerPointPresentation()
' to test this code, paste it into an Excel module
' add a reference to the PowerPoint-library
' create a new folder named C:\Foldername or edit the filnames in the code
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptShape As PowerPoint.Shape
Dim i As Integer, strString As String
Dim fileName As String
Dim chartName As String

   fileName = "C:\Documents and Settings\hzg3nc\Desktop\VBA.ppt"
 
   Set pptApp = CreateObject("PowerPoint.Application")
   Set pptPres = pptApp.Presentations.Add(msoTrue) ' create a new presentation
   ' or open an existing presentation
   ' Set pptPres = pptApp.Presentations.Open("C:\Foldername\Filename.ppt")
 
   ' apply a slide template
   pptPres.ApplyTemplate "C:\Documents and Settings\hzg3nc\Application Data\Microsoft\Templates\default.pot"
 
   ActiveWorkbook.Charts("Chart-Main").ChartArea.Copy ' copy an Excel chart
   With pptPres.Slides
       Set pptSlide = .Add(.count + 1, ppLayoutTitleOnly) ' add a slide
   End With
   With pptSlide
       .Shapes(1).TextFrame.TextRange.Text = ActiveWorkbook.Charts("Chart-Main").ChartTitle.Characters.Text ' add a slide title
       .Shapes(1).TextFrame.TextRange.Font.Size = 22
       .Shapes.PasteSpecial ppPasteBitmap
       With .Shapes(.Shapes.count)
           .Left = 10
           .Top = 70
           .Height = 425
           .Width = 695
       End With
   End With
 
   For i = 1 To 11
       chartName = "Chart " + CStr(i)
       ActiveWorkbook.Charts(chartName).ChartArea.Copy ' copy an Excel chart
       With pptPres.Slides
           Set pptSlide = .Add(.count + 1, ppLayoutTitleOnly) ' add a slide
       End With
       With pptSlide
           .Shapes(1).TextFrame.TextRange.Text = ActiveWorkbook.Charts(chartName).ChartTitle.Characters.Text ' add a slide title
           .Shapes(1).TextFrame.TextRange.Font.Size = 22
           .Shapes.PasteSpecial ppPasteBitmap
           With .Shapes(.Shapes.count)
               .Left = 10
               .Top = 70
               .Height = 425
               .Width = 695
           End With
       End With
   Next i
 
 
   Application.CutCopyMode = False ' end cut/copy from Excel
   Set pptSlide = Nothing
 
   On Error Resume Next ' ignore errors
   Kill fileName
   With pptPres
       .SaveAs fileName
       '.Close ' close the presentation
   End With
   On Error GoTo 0 ' resume normal error handling
   Set pptPres = Nothing
 
   pptApp.Visible = True ' display the application
   'pptApp.Quit ' or close the PowerPoint application
   Set pptApp = Nothing
End Sub

Create bubble charts from excel sheet

Sub CreateBubbleChart()
Dim rMain As Range
Dim strVal As String, sIndex As Integer, lastRow As Integer, firstRow As Integer, count As Integer
Dim sCollection As SeriesCollection

    Sheets("customer_annoyance").Activate
    Range("D2:F7").Select
    Charts.Add
    ActiveChart.ChartType = xlBubble3DEffect

    Set rMain = Sheets("customer_annoyance").Range("A1:F66")

    strVal = rMain.Cells(2, 2)
    sIndex = 2
    count = 1
    Set sCollection = ActiveChart.SeriesCollection
    sCollection.Item(1).Delete
    For i = 3 To rMain.Rows.count
        If rMain.Cells(i, 2) <> strVal Then
           
            'MsgBox strVal & " (" & CStr(sIndex) & " to " & CStr(i - 1) & ")"
            firstRow = sIndex
            lastRow = i - 1
           
           
            sCollection.Add Source:=rMain.Range("D" & CStr(firstRow) & ":F" & CStr(lastRow))
                       
            ActiveChart.SeriesCollection(count).XValues = _
                "=customer_annoyance!R" & CStr(firstRow) & "C4:R" & CStr(lastRow) & "C4"
            ActiveChart.SeriesCollection(count).Values = _
                "=customer_annoyance!R" & CStr(firstRow) & "C5:R" & CStr(lastRow) & "C5"
            ActiveChart.SeriesCollection(count).name = _
                "=customer_annoyance!R" & CStr(firstRow) & "C2"
            ActiveChart.SeriesCollection(count).BubbleSizes = _
                "=customer_annoyance!R" & CStr(firstRow) & "C6:R" & CStr(lastRow) & "C6"
            count = count + 1
            strVal = rMain.Cells(i, 2)
            sIndex = i
        End If
    Next i
    'MsgBox strVal & " (" & CStr(sIndex) & " to " & CStr(i - 1) & ")"
    firstRow = sIndex
    lastRow = i - 1
    ActiveChart.SeriesCollection(count).name = _
        "=customer_annoyance!R" & CStr(firstRow) & "C2"
    ActiveChart.SeriesCollection(count).XValues = _
        "=customer_annoyance!R" & CStr(firstRow) & "C4:R" & CStr(lastRow) & "C4"
    ActiveChart.SeriesCollection(count).Values = _
        "=customer_annoyance!R" & CStr(firstRow) & "C5:R" & CStr(lastRow) & "C5"
    ActiveChart.SeriesCollection(count).BubbleSizes = _
        "=customer_annoyance!R" & CStr(firstRow) & "C6:R" & CStr(lastRow) & "C6"
   
   
    ActiveChart.Location Where:=xlLocationAsNewSheet, name:="Chart-One"
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = _
        "Frequency (IPTV) vs Severity (Customer Impact)"
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = _
        "Severity (Customer Impact)"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Frequency (IPTV)"
    End With
    ActiveChart.SeriesCollection(1).Select
    With ActiveChart.ChartGroups(1)
        .VaryByCategories = False
        .ShowNegativeBubbles = False
        .SizeRepresents = xlSizeIsArea
        .BubbleScale = 35
    End With
    With ActiveChart.Axes(xlCategory)
        .MinimumScale = 4
        .MaximumScale = 11
    End With
    With ActiveChart.Axes(xlValue)
        .MinimumScale = 0
        .MaximumScale = 25
    End With

End Sub

Create individual series charts from a master bubble chart

Sub CopyCharts()
Dim src As Chart
Dim des As Chart
Dim index As Integer
Dim name As String
Dim series As series
Dim sCollection As SeriesCollection
Dim lEntries As LegendEntries
Dim l As LegendEntry

    Set src = Sheets("Chart-One")
   
    For index = 1 To 11
        src.Copy Before:=Sheets("customer_annoyance")
        Set des = ActiveChart
        name = "Dhart " & CStr(index)
        des.name = name
       
        Set sCollection = des.SeriesCollection
        Set lEntries = des.legend.LegendEntries
       
        For i = 1 To sCollection.count
            Set series = sCollection.Item(i)
            If (i <> index) Then
                series.Border.LineStyle = xlNone
                series.Interior.ColorIndex = xlNone
                               
                Set l = lEntries.Item(i)
                l.Font.ColorIndex = 2
                l.Font.Background = xlTransparent
            Else
            End If
        Next i
    Next index
End Sub

Java - Matlab Connection
11 Jan 2007

Here is a small demonstration program which allows you to type the text:

a = [1 2 3];

in a java application (launched from within matlab) and send it into Matlab's workspace as matrix data.

This is how you do it:

1. Download the MatlabInterface.jar [or the Netbeans Project MatlabInterface]

2. To Compile your own code add jmi.jar [%MATLABROOT%/java/jar] from the following directory in Project Properties->Libraries->Add JAR/zip

3. Matlab Command Window:

>> javaaddpath('C:\Debprakash\Java\MatlabInterface\dist\MatlabInterface.jar');
>> import org.test.MatDialog;
>> MatDialog.test
r = [98 93 52 39 31 17 10 39 43 97 ];
>> r
r = 

   98    93    52    39    31    17    10    39    43    97

Java Code for MatDialog.java


Create the Matlab object which connects to the current matlab session.
-----------------------------------------------------------------------

package org.test;

import java.util.Date;
import com.mathworks.jmi.*;

public class MatDialog extends javax.swing.JFrame
{
    private Matlab matlab;
    public MatDialog()
    {
        ...
        matlab = new Matlab();
    }

Add an action listener to call eval on the matlab object
------------------------------------------------------

...
private void jButtonProcessActionPerformed(java.awt.event.ActionEvent evt)
{
   ...
   else if (jRadioButton2.isSelected())
   {
      cmd = jTextField1.getText();
   }

   if (cmd != null)
   {
      System.out.println(cmd);
      matlab.eval(cmd);
   }
}

For More Info

See Integrating Java Components into MATLAB

Source code download
Calling Matlab From Java
Calling matlab in Java