stacked chart vba, variable number of row

subazz · Sep 16, 2015

im trying to generate a vba funktion that analysis my Proccestime for some data extraction.

I face two obstacles.
1)
i need the vba function to return how many rows that have data (Each row represent a patient)

2)
I need the vba funktion to create a stacked charted with two series.
column:
a; is catagory
b; is series 1
c; is series 2

data starts from frow 6 and.
The difficult part for my to figure out is how i select to end of row(Meaning the number of patients may varie )

I sencerely hope its possible. The VBA would ease the proccess alot, scoring some nice point with the employer >-<

thanks in advance
Subash Suntharalingam
Lab TEch
Glostrup hospital
Denmark

p45cal · Sep 20, 2015

You might get away with the following if the data for the chart is bounded by completely blank rows and columns or the edge of the sheet:

Code:

Sub blah()
Range("A6").Select
ActiveSheet.Shapes.AddChart (xlColumnStacked)
End Sub

subazz · Sep 22, 2015

Thanks for the advice!.
I was looking forward to getting back at work and try this out.
Unfortunately, the code doesnt generate a chart at all.

So.. il have to keep looking..
Thanks anyways

p45cal · Sep 22, 2015

Supply your worksheet (altered with find/replace if sensitive data).

subazz · Sep 22, 2015

p45cal said:
Supply your worksheet (altered with find/replace if sensitive data).

Ived attached a file with hopefully only non sensitive data.

the vba code that im currently running is :

Code:

Sub AKTUEL()
'
' AKTUEL Makro
'
' Genvejstast:Ctrl+s
 'spalt celler
'
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(21, 2)), TrailingMinusNumbers:=True
    Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 2), Array(4, 2)), TrailingMinusNumbers:=True
        
        'tilføj filter og skul kolonner
        
    Rows("1:1").Select
    Selection.AutoFilter
    Columns("B:C").Select
    Selection.EntireColumn.Hidden = True
    ActiveWindow.ScrollColumn = 2
    Columns("F:F").Select
    Selection.EntireColumn.Hidden = True
    Columns("J:J").Select
    Selection.EntireColumn.Hidden = True
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    Columns("L:P").Select
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 17
    Columns("L:Q").Select
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    Columns("L:AA").Select
    Selection.EntireColumn.Hidden = True
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 1
    Columns("E:E").Select
    Selection.EntireColumn.Hidden = True
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    
    ' Filter efter buffey
    
    ActiveSheet.Range("$A$1:$AC$302").AutoFilter Field:=4, Criteria1:= _
        "Buffycoat-EDTA"
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("G1:G302"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.ScrollColumn = 2
    
    ' formater måned dag og år for udtræk
    
    Columns("H:K").Select
    Selection.NumberFormat = "m/d/yyyy h:mm"
    Columns("AB:AB").Select
    
    'indsæt kolonner og format time : mm
    
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("AB:AD").Select
    Selection.NumberFormat = "h:mm"
    
    ' udregn tidsforskel og navngiv celler
    
    
    Range("AB5").Select
    ActiveCell.FormulaR1C1 = "=RC[-19]-RC[-20]"
    Range("AC5").Select
    ActiveCell.FormulaR1C1 = "=RC[-18]-RC[-20]"
    Range("AD5").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]+RC[-2]"
    Range("AB1").Select
    ActiveCell.FormulaR1C1 = "Udt. Til modt."
    Range("AC1").Select
    ActiveCell.FormulaR1C1 = "Modt til i frys"
    Range("AD1").Select
    ActiveCell.FormulaR1C1 = "Total tid"
    Range("AB5").Select
    
    ' Træk formular ned til end xlup.
    
    Range("AB5:AD5").AutoFill Destination:=Range("AB5:AD" & Cells(Rows.Count, "k").End(xlUp).Row)
    Columns("G:K").Select
    Selection.EntireColumn.Hidden = True
    Range("A1").Select
    ActiveCell.CurrentRegion.Select
    
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets.Add
    ActiveSheet.Paste
    
    Columns("A:A").ColumnWidth = 20.56
    Columns("A:A").ColumnWidth = 23.22
    Columns("B:B").ColumnWidth = 10.56
    Columns("C:C").ColumnWidth = 13.11
    Columns("D:D").ColumnWidth = 12.78
    Columns("E:E").ColumnWidth = 13.11
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.Cut
    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight
    Selection.ColumnWidth = 18
    Range("B22").Select
    
        Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Antal rækker"
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Periode"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "procent pr række"
    Range("A4").Select
    
    ' sorter
    
      Rows("5:5").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Ark1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Ark1").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "D5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Ark1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    'akkummuleret
    
       ActiveCell.FormulaR1C1 = "=100"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "=100/R[-1]C"
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    
    Range("E6").Select
    ActiveCell.FormulaR1C1 = "=R[-3]C[-3]"
    Range("E7").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+R[-4]C[-3]"
    Range("E8").Select
    
    
    Columns("E:E").Select
    Selection.NumberFormat = "0.00"
    Range("E7").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+R3C2"
    Range("E8").Select
    Range("E5").Select
    ActiveCell.FormulaR1C1 = "Akkummuleret procent"
    Range("E6").Select
    Columns("E:E").ColumnWidth = 20.78
    Columns("E:E").Select
    Selection.NumberFormat = "0"
    
    ' filldown Makro
    
    Range("D7").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.filldown
    
    ' format af procent
    
    Range("B3").Select
    Selection.NumberFormat = "0.00"
End Sub

p45cal · Sep 22, 2015

2 questions:
1. You have the line beginning ActiveWorkbook.Worksheets("Ark1").AutoFil.....
Is there a line missing in the code that renames the freshly created sheet to Ark1 or is this an existing sheet elsewhere?

2. You have the line ActiveCell.FormulaR1C1 = "=100"
Which is the active cell at the time? (When I run it it is cell A5 which contains a header which I doubt you want changing to a formula.)

p45cal · Sep 22, 2015

Finally, what data do you want plotting? A5:C5 all the way down?

subazz · Sep 22, 2015

When i run the action, it creates a new sheet named "ark1"
at this point
"
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste"
The newly generated sheet is named ark1. isnt it just the language difference in excel setting?

Regarding the second question.
You are absolutely right. That wasnt right.

i was trying to buil data to generate a chart of processtime as a function of percentage.
Hence my need to have the numbers of patients/rows. (which is a second chart that i didnt post about in this thread)

p45cal said:
2 questions:
1. You have the line beginning ActiveWorkbook.Worksheets("Ark1").AutoFil.....
Is there a line missing in the code that renames the freshly created sheet to Ark1 or is this an existing sheet elsewhere?

2. You have the line ActiveCell.FormulaR1C1 = "=100"
Which is the active cell at the time? (When I run it it is cell A5 which contains a header which I doubt you want changing to a formula.)

subazz · Sep 22, 2015

exactly.
row 5 is series name tho..

p45cal · Sep 22, 2015

subazz said:
The newly generated sheet is named ark1. isnt it just the language difference in excel setting?

Yes, you're quite right, I should have guessed that Ark is Sheet in Danish/Swedish/Norwegian! Sorry!

subazz said:
Regarding the second question.
You are absolutely right. That wasnt right.
i was trying to buil data to generate a chart of processtime as a function of percentage.
Hence my need to have the numbers of patients/rows. (which is a second chart that i didnt post about in this thread)

So what should I do here?

p45cal · Sep 22, 2015

Attached is a file with a re-written macro to shorten it and make it a bit more robust.
The first line of the macro (Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)) is a line I added temporarily, to work on a copy of your Sheet1 so as not to lose the original data layout. If the macro works to your satisfaction you only have to delete this line to make it work on the original Sheet1.

Things which weren't robust were things such as working on a filtered list to change formats, add formulae, sorting; lines such as:
Range("AB5").Select
ActiveCell.FormulaR1C1 = "=RC[-19]-RC[-20]"
which were working on a filtered list where row 5 was the first visible cell; row 5 isn't always going to be the first visible row.
Adding formats to a filtered list only seemed to add formats to the visible cells.

Now I hope that this gives the same results as your previous macro YOU MUST CHECK this. (Edit: I did some checking and it seems to be right)

Finally I added a couple of lines to add a chart.

[There are actually 2 macros in the attached; they're both the same, one is with many commented-out code lines removed]

subazz · Sep 23, 2015

p45cal said:
Yes, you're quite right, I should have guessed that Ark is Sheet in Danish/Swedish/Norwegian! Sorry!

So what should I do here?

These are the charts that i ultimetly want.

the thread was build to solved obstacles in generating the chart to the right in adhered picture.. (with variable numbers of rows/catagory/patients)

Actually i dont need to change anything in a5
b3 is 100/b2
what i need is for b2 to be the exact number of rows counting from A6 untill end.

purpose of this is to calculate and return b3 the percentage each row is

atm after running the vba i manually do some work to get there.

in b2 i type "=rows(and mark the area)"

and then select data for the charts manually.

subazz · Sep 23, 2015

Thats just awsome work!

im trying to figure out your codes. but geniously youved written comments. MUCH appriciated !

for me its more complicated lol.. i have like few string to work with. and i doubt that i will ever be a pro at this..
fortunetly there are some kindhearted people helping each other out there..

subazz · Sep 23, 2015

Thats just aswome mate!.
I actually learned alot from reading your code.
and you are right. i needed to sort by "total time" "total tid"
the with. sort seems great.

however i dont see at which point you chose chart type ?

p45cal · Sep 23, 2015

subazz said:
however i dont see at which point you chose chart type ?

Set NewCht = .Shapes.AddChart(xlColumnStacked)

p45cal · Sep 23, 2015

subazz said:
what i need is for b2 to be the exact number of rows counting from A6 untill end.

Add the line:
.Range("B2").Value = LastRow - 5
after:
LastRow = .Cells(1).SpecialCells(xlCellTypeLastCell).Row

p45cal · Sep 23, 2015

subazz said:
These are the charts that i ultimetly want.

1. What columns is the left chart plotting?
2. Is it an XY scatter type or line type?

subazz · Sep 23, 2015

you are doing some serious magic !

subazz · Sep 23, 2015

does it matter if its a XY or a line ?.. im just trying to show time as a function of percentage.. so that i can eventually tell that 90% has been handled within e.g 3 hours

subazz · Sep 23, 2015

data has been taken from column D and E

stacked chart vba, variable number of row

New member

Super Moderator

Attachments

New member

Super Moderator

New member

Attachments

Super Moderator

Super Moderator

New member

New member

Super Moderator

Super Moderator

Attachments

New member

Attachments

New member

New member

Super Moderator

Super Moderator

Super Moderator

New member

New member

New member