Don't like ads? PRO users don't see any ads ;-)
Guest

Untitled

By: a guest on Aug 12th, 2012  |  syntax: None  |  size: 2.20 KB  |  hits: 8  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. Creating a 2d stacked column chart with priority
  2. Task 1   Task 2   Task 3   <- x-axis  
  3. A  100   B 400    B 510    <- This row is position 1      
  4. B  200   A 200    A 300    <- This row is position 2  
  5. ^-Legend
  6.        
  7. 'Run this macro from the sheet containing your data, after highlightling the data.
  8. Sub Macro3()
  9.  
  10.   'The below code assumes that you have already selected
  11.   'the columns containing your data and that the first column,
  12.   'and every 2nd column after that contains your legend keys.
  13.   Dim rng As Range
  14.   Set rng = Selection
  15.  
  16.   Dim colNum As Integer
  17.   Dim rowNum As Integer
  18.   Dim strLegend As String
  19.   Dim rowStart As Integer
  20.   Dim colStart As Integer
  21.   Dim strSeries As String
  22.   Dim i As Integer
  23.   Dim seriesNum As Integer
  24.   Dim shtName As String
  25.  
  26.   rowStart = rng.Row
  27.   colStart = rng.Column
  28.   shtName = ActiveSheet.Name & "!"
  29.  
  30.   'Creates an empty chart...
  31.   ActiveSheet.Shapes.AddChart.Select
  32.   '...of type StackedColumn.
  33.   ActiveChart.ChartType = xlColumnStacked
  34.  
  35.   seriesNum = 0
  36.   'Select all the cells that match the legend in the first column.
  37.   For rowNum = 0 To rng.Rows.Count - 1
  38.     strLegend = Cells(rowStart + rowNum, colStart).Value
  39.     strSeries = "=" & shtName & Cells(rowStart + rowNum, colStart + 1).Address
  40.     For colNum = 2 To rng.Columns.Count - 1 Step 2
  41.         For i = 0 To rng.Rows.Count - 1
  42.             If Cells(rowStart + i, colStart + colNum).Value = strLegend Then
  43.                 strSeries = strSeries & "," & shtName & Cells(rowStart + i, colStart + colNum + 1).Address
  44.                 Exit For
  45.             End If
  46.         Next
  47.     Next
  48.     'Create a new series.
  49.     ActiveChart.SeriesCollection.NewSeries
  50.     seriesNum = seriesNum + 1
  51.     'Set the legend.
  52.     ActiveChart.SeriesCollection(seriesNum).Name = strLegend
  53.     'Set the X axis labels to nothing, so the default is used.
  54.     ActiveChart.SeriesCollection(seriesNum).XValues = ""
  55.     'Set the series data.
  56.     ActiveChart.SeriesCollection(seriesNum).Values = strSeries
  57.   Next
  58.   'An extra series gets added automatically???
  59.   'This code removes it.
  60.   If ActiveChart.SeriesCollection.Count > rng.Rows.Count Then
  61.     ActiveChart.SeriesCollection(rng.Rows.Count + 1).Delete
  62.   End If
  63. End Sub
  64.        
  65. A | 100 | B | 400 | B | 510
  66. B | 200 | A | 200 | A | 300